Decoding temporal structure in narratives using functional connectivity pattern
Narrative Structure in Animation & Functional Connectivity Pattern
Taehoon Kim, Suhyun Lee, Seonhwa Park, Yeongeun Ban, Ghootae Kim
Deep Memory Lab, Cognitive Science Research Group, Korea Brain Research Institute2022-01-20
1 Abstract
We perceive and memorize a set of continuous events as a narrative with plot structure, such as exposition, complication, climax, and resolution. Although many previous studies investigated how the brain constructs a unitary representation of a visual object consisting of many different parts, few studies examined how a temporal structure of narratives is represented in the brain. Here we investigated if the narrative structure can be decoded based on functional connectivity information acquired while participants are watching short film animations. These films were divided into an early (exposition and complication) and a later part (climax and resolution) by independent raters, and fMRI data during film watching were split into the two parts accordingly. Each of the splits was transformed into a functional connectivity matrix, and we tested whether the temporal structure (i.e., early, or later part) can be decoded based on the connectivity information using representational similarity and multivariate classification analyses. We could successfully decode the temporal structure of the narratives in both analyses: That is, irrespective of the contents, early and later parts of narratives had differential connectivity patterns from each other. Interestingly, the temporal structure decoding was also successful even when the same analyses were performed “across participants”. In a subsequent analysis, we found that the narrative structure information was predominantly represented in the visual, fronto-parietal, default mode networks. Our findings show that network-level interactions in the brain support representation of narrative structure independent from contents of narratives and individual difference in functional connectivity.
2 Preparation
set.seed(12345) # for reproducibility
options(knitr.kable.NA = '')
# install // load packages
# Some packages need to be loaded.
# We use `pacman` as a package manager, which takes care of the other packages.
if (!require("distill", quietly = TRUE)) install.packages("distill")
if (!require("devtools", quietly = TRUE)) install.packages("devtools")
if (!require("papaja", quietly = TRUE)) devtools::install_github("crsh/papaja")
if (!require("patchwork", quietly = TRUE)) devtools::install_github("thomasp85/patchwork")
if (!require("klippy", quietly = TRUE)) devtools::install_github("RLesur/klippy")
if (!require("pacman", quietly = TRUE)) install.packages("pacman")
if (!require("Rmisc", quietly = TRUE)) install.packages("Rmisc")
if (!require("rstatix", quietly = TRUE)) install.packages("rstatix")
if (!require("effsize", quietly = TRUE)) install.packages("effsize")
if (!require("lsr", quietly = TRUE)) install.packages("lsr")
if (!require("effectsize", quietly = TRUE)) install.packages("effectsize")
if (!require("ggbeeswarm", quietly = TRUE)) install.packages("ggbeeswarm") # Never load it directly.
pacman::p_load(tidyverse, papaja, knitr, dplyr, car, psych, afex, lme4, lmerTest,
emmeans, ggplot2, ggpubr, lattice, latticeExtra, parallel,
effects, psycho, caret, sjPlot, ppcor, rstatix)
library("patchwork"); library("klippy")
klippy::klippy()targ_sn = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 14, 15 ,16, 17, 18, 19, 20, 21)
# 12 제외3 Stimiulus Check
참가자들은 스캐너 안에서 총 30개의 짧은 이야기 영상을 보았다. 이야기의 시간 흐름을 추적하기 위해, 각 이야기는 별도의 평정자들에 의해 발단과 전개를 포함하는 전반부와 전환과 결말을 포함하는 후반부로 분할되었다. 분할된 영상의 구획별 지속 시간이 서로 큰 차이를 가지는 경우 기능적 연결성이 잘못 추정될 가능성이 있다. 이러한 가능성을 확인하기 위해 구획의 전반부, 후반부 간 지속 시간 차이를 분석하였다.
fMRI TR(2000ms) 별로 분석한 요약치는 아래와 같다.
s1 <- read.csv("data/stim_info_cal_2pt.csv", header = T)
s1$idx = factor(s1$idx)
## 3 part
s2 <- s1 %>% dplyr::select(idx, durTR, dur_p1_tr, dur_p2_tr)
s2 <- gather(s2, key = part, value = tr, dur_p1_tr:dur_p2_tr, factor_key=T)
s2$part <- factor(s2$part, levels=c("dur_p1_tr", "dur_p2_tr"),
labels = c("p1", "p2"))
glimpse(s2, width = 70)
## Rows: 60
## Columns: 4
## $ idx <fct> 2, 9, 10, 13, 15, 24, 25, 33, 44, 49, 58, 62, 68, 74, …
## $ durTR <int> 99, 75, 106, 83, 85, 105, 102, 92, 88, 88, 78, 71, 111…
## $ part <fct> p1, p1, p1, p1, p1, p1, p1, p1, p1, p1, p1, p1, p1, p1…
## $ tr <int> 64, 21, 43, 50, 53, 77, 44, 39, 53, 45, 45, 40, 34, 37…
s2.w <- s2 %>% spread(key = part, value = tr)
s2.G <- s2 %>% group_by(part) %>% rstatix::get_summary_stats(tr)
s2.G %>% kable(digits = 2)| part | variable | n | min | max | median | q1 | q3 | iqr | mad | mean | sd | se | ci |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| p1 | tr | 30 | 21 | 77 | 45 | 39.00 | 53.00 | 14.0 | 11.86 | 46.13 | 11.57 | 2.11 | 4.32 |
| p2 | tr | 30 | 31 | 77 | 53 | 39.25 | 61.75 | 22.5 | 17.05 | 51.77 | 13.93 | 2.54 | 5.20 |
library(RColorBrewer)
s.plot <- ggplot(data=s2, aes(x=part, y=tr, fill=part)) +
stat_summary(fun = mean, geom = "bar", position="dodge",
na.rm = TRUE, alpha = .9, width = 0.8,
color="black", size = 0.15) +
geom_point(data=s2, aes(x=part, y=tr, fill=part), position = position_dodge(width=0.8),
size=2, show.legend=F, color="gray90") +
geom_segment(data=s2.w, inherit.aes = FALSE,
aes(x=1, y=filter(s2.w)$p1,
xend=2, yend=filter(s2.w)$p2),
color="gray90", alpha = .7) +
geom_errorbar(data=s2.G,
aes(x = part, y=mean, ymin = mean - ci, ymax = mean + ci), width=.2,
position=position_dodge(.8), color = "black") +
coord_cartesian(ylim = c(0, 100), clip = "on") +
scale_fill_manual(values = c("#ED7D31", "#5B9BD5"), # c("#ED7D31", "#5B9BD5", "#70AD47"),
labels = c("First Half", "Second Half")) +
# scale_fill_brewer(palette="Set2", labels = c("Part 1", "Part 2")) +
labs(x = "Part", y = "Duration (TR)") +
theme_bw(base_size = 18) +
theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
# axis.text = element_text(face = "plain", size = 15, color = "black"),
# axis.text.x = element_text(face = "plain", size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position=c(0.8, 0.85))
s.plot
전반부와 후반부 간 지속 시간 차이는 통계적으로 유의하지 않았다. 따라서 아래의 분석 결과에 지속 시간의 차이가 체계적인 영향을 주었을 가능성은 적다.
s2.aov <- s2 %>% anova_test(tr ~ part + Error(idx/part), detailed = F)
get_anova_table(s2.aov, correction = "GG") %>% kable(digits=2)| Effect | DFn | DFd | F | p | p<.05 | ges |
|---|---|---|---|---|---|---|
| part | 1 | 29 | 2.12 | 0.16 | 0.05 |
p_h1 <- s2 %>% rstatix::pairwise_t_test(tr ~ part,
p.adjust.method="holm",
paired=T, detailed=T) %>%
dplyr::select(group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- s2 %>%
rstatix::cohens_d(tr ~ part, paired=T, ci = F) %>%
dplyr::select(group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("group1", "group2")) %>% kable(digits=3)| group1 | group2 | estimate | conf.low | conf.high | df | statistic | p.adj | p.adj.signif | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|
| p1 | p2 | -5.633 | -13.553 | 2.286 | 29 | -1.455 | 0.156 | ns | -0.266 | small |
4 Behavior Results
기능적 연결성 분석에 앞서 참가자들이 영상을 성실히 보았는지, 제대로 이해하며 보았는지 정도를 확인할 필요가 있다. 스캔 세션이 끝난 후, 참가자들이 영상을 제대로 이해하며 보았는지 여부를 별도의 행동 검사를 통해 확인하였다. 영상 별로 이야기 흐름에 따라 구분되는 3개의 스틸컷을 준비하였고, 참가자들은 각 스틸컷을 시간 순서에 따라 재배열하였다. 이에 더하여, 해당 영상이 이해가 잘되었는지의 정도를 평정하였다. 마지막으로 영상을 보는 도중 집중하지 않았거나 존 경우, 별도로 체크하였다 (check = 1(성실히 보지않은 경우) or 0(성실히 본 경우)).
bh <- read.csv("data/aniFCnet_behav.csv", header = T)
glimpse(bh, width = 80)
## Rows: 630
## Columns: 7
## $ Idx <int> 26, 21, 12, 22, 7, 6, 4, 30, 29, 14, 5, 10, 28, 17, 19, 15…
## $ num <int> 26, 21, 12, 22, 7, 6, 4, 30, 29, 14, 5, 10, 28, 17, 19, 15…
## $ stimIdx <int> 2, 9, 10, 13, 15, 24, 25, 33, 44, 49, 58, 62, 68, 74, 81, …
## $ sn <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ correctness <int> 1, 1, 0, 0, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ scores <int> 9, 9, 1, 1, 7, 9, 9, 1, 1, 7, 8, 9, 6, 6, 8, 9, 9, 6, 9, 6…
## $ check <int> 0, 0, 1, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
bh_l <- bh %>% filter(sn %in% targ_sn)
bh_l$sn = factor(bh_l$sn)
bh_l$stimIdx = factor(bh_l$stimIdx)
bh_l$corr = bh_l$correctness
bh_t <- bh_l %>% dplyr::select(sn, stimIdx, corr, scores, check)영상을 제대로 보지 않은 것으로 체크된 경우를 요약하였다.
bh_1 <- bh_l %>% filter(check == 0)
# mean number of trials for each conditions
bh_1 %>% group_by(sn) %>%
dplyr::summarise(NumTrial = length(corr)) %>%
ungroup() %>%
dplyr::summarise(Mean = mean(NumTrial),
Median = median(NumTrial),
Min = min(NumTrial),
Max = max(NumTrial),
OutN = sum(NumTrial),
TotalN = (30*length(sn)),
OutProp = 100 - sum(NumTrial)/(30*length(sn))*100 ) %>%
ungroup %>%
kable(digits=2)| Mean | Median | Min | Max | OutN | TotalN | OutProp |
|---|---|---|---|---|---|---|
| 28.45 | 29 | 25 | 30 | 569 | 600 | 5.17 |
bh_1 %>% group_by(sn) %>%
dplyr::summarise(NumTrial = length(corr)) %>%
ungroup() %>% spread(key = sn, value = NumTrial) %>%
kable(digits=2)| 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 25 | 30 | 29 | 30 | 30 | 26 | 27 | 30 | 29 | 28 | 29 | 29 | 30 | 27 | 29 | 25 | 28 | 30 | 30 | 28 |
4.1 By Subject, Accuracy
영상을 보았지만 이야기를 잘 이해하지 못한 경우, 즉, 스틸컷 순서 맞추기 검사에서 틀린 경우를 요약하였다. 여기서 영상을 성실히 보지 않은 경우(check = 0)는 틀린 것으로 처리하였다. 그 결과, 최소 75% 이상의 정확도를 보였다.
bh_2 <- bh_l %>% filter(corr == 1)
# mean number of trials for each conditions
bh_2 %>% group_by(sn) %>%
dplyr::summarise(NumTrial = length(corr)) %>%
ungroup() %>%
dplyr::summarise(Mean = mean(NumTrial),
Median = median(NumTrial),
Min = min(NumTrial),
Max = max(NumTrial),
OutN = sum(NumTrial),
TotalN = (30*length(sn)),
OutProp = 100 - sum(NumTrial)/(30*length(sn))*100 ) %>%
ungroup %>%
kable(digits=2)| Mean | Median | Min | Max | OutN | TotalN | OutProp |
|---|---|---|---|---|---|---|
| 27.6 | 28 | 24 | 30 | 552 | 600 | 8 |
bh_2 %>% group_by(sn) %>%
dplyr::summarise(NumTrial = length(corr)) %>%
ungroup() %>% spread(key = sn, value = NumTrial) %>%
kable(digits=2)| 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 25 | 29 | 30 | 24 | 29 | 29 | 29 | 29 | 29 | 27 | 28 | 27 | 30 | 26 | 25 | 27 | 28 | 27 | 26 | 28 |
bh_3 <- bh_l
# glimpse(bh_1)
# subject-level, long format
bh_allL <- bh_3 %>% group_by(sn) %>%
dplyr::summarise(acc=mean(corr)*100) %>%
ungroup()
# bh_allL %>% kable(digits=2)
bh_allL.1 <- bh_allL %>%
nest() %>%
mutate(lbound = map(data, ~mean(.$acc)-2*sd(.$acc)),
ubound = map(data, ~mean(.$acc)+2*sd(.$acc))) %>% # make new data (3sd cut)
unnest(c(lbound, ubound))%>%
unnest(data) %>%
mutate(Outlier = (acc < lbound)|(acc > ubound))
## Warning: `...` must not be empty for ungrouped data frames.
## Did you want `data = everything()`?
#filter(Outlier == FALSE) %>% # filtering outlier
# subject-level, wide format
bh_allG <- rstatix::get_summary_stats(bh_allL) %>%
mutate(acc.m = mean, acc.sd = sd, acc.se = se, acc.ci = ci) %>%
dplyr::select(acc.m, acc.sd, acc.se, acc.ci)
bh_allG <- bh_allG %>%
mutate(lower.ci = acc.m-acc.ci,
upper.ci = acc.m+acc.ci,
lower.se = acc.m-acc.se,
upper.se = acc.m+acc.se)
bh_allL %>% spread(key = sn, value = acc) %>% kable(digits=1)| 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 83.3 | 96.7 | 100 | 80 | 96.7 | 96.7 | 96.7 | 96.7 | 96.7 | 90 | 93.3 | 90 | 100 | 86.7 | 83.3 | 90 | 93.3 | 90 | 86.7 | 93.3 |
bh_allG %>% kable(digits=2)| acc.m | acc.sd | acc.se | acc.ci | lower.ci | upper.ci | lower.se | upper.se |
|---|---|---|---|---|---|---|---|
| 92 | 5.76 | 1.29 | 2.7 | 89.3 | 94.7 | 90.71 | 93.29 |
bh_allG$x <- 1
bh_allG$x <- factor(bh_allG$x)
bh.plot1 <- ggplot(data=bh_allG, aes(x=x, y=acc.m)) +
stat_summary(fun = mean, geom = "bar", position="dodge", fill="gray70",
na.rm = TRUE, alpha = .9, width = 0.7, color="black", size = 0.15) +
geom_errorbar(data=bh_allG,
aes(x = 1, y=acc.m, ymin = acc.m - acc.ci, ymax = acc.m + acc.ci), width=.2,
position=position_dodge(.8), color = "black") +
geom_hline(yintercept=70, linetype='dashed', color='darkred', alpha =1, size=1) +
coord_cartesian(ylim = c(0, 100), clip = "on") +
# coord_cartesian(ylim = c(0, 5), clip = "on") +
labs(x = "Group", y = "Mean Accuracy (%)") +
# scale_x_discrete(labels=c("Summary")) +
theme_bw(base_size = 18) +
theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position=c(0.8, 0.85))
# bh.plot1
bh.plot2 <- ggplot(data=bh_allL, aes(x=sn, y=acc)) +
stat_summary(fun = mean, geom = "bar", position="dodge", fill="gray70",
na.rm = TRUE, alpha = .9, width = 0.8, color="black", size = 0.15) +
geom_hline(yintercept=60, linetype='dashed', color='darkred', alpha =1, size=1) +
coord_cartesian(ylim = c(0, 100), clip = "on") +
# coord_cartesian(ylim = c(0, 5), clip = "on") +
labs(x = "Subject Number", y = "Accuracy (%)") +
theme_bw(base_size = 18) +
theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", size = 15, color = "black"),
axis.text.x = element_text(face = "plain", size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position=c(0.8, 0.85))
# bh.plot2
bh.plot <- ggarrange(bh.plot1, bh.plot2, ncol = 2, widths = c(1,3),
labels = c("A", "B"))
bh.plot
4.2 By Subject, Comprehension Score
각 참가자들이 영상이 이해가 잘되었는지의 정도를 평정한 결과를 요약하였다. 여기서 점수가 높을수록 이해가 잘되었음을 나타낸다.
# subject-level, long format
bh_allL <- bh_1 %>% group_by(sn) %>%
dplyr::summarise(score=mean(scores)) %>%
ungroup()
# bh_allL %>% kable(digits=2)
# subject-level, wide format
bh_allG <- rstatix::get_summary_stats(bh_allL) %>%
mutate(score.m = mean, score.sd = sd, score.se = se, score.ci = ci) %>%
dplyr::select(score.m, score.sd, score.se, score.ci)
bh_allG <- bh_allG %>%
mutate(lower.ci = score.m-score.ci,
upper.ci = score.m+score.ci,
lower.se = score.m-score.se,
upper.se = score.m+score.se)
bh_allL %>% spread(key = sn, value = score) %>% kable(digits=2)| 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 7.76 | 8.5 | 8.48 | 8.2 | 7.5 | 8.31 | 8.48 | 6.7 | 8.38 | 8.29 | 8.83 | 7.48 | 8.73 | 8.67 | 5.52 | 7.2 | 8.5 | 8.1 | 8.23 | 7.32 |
bh_allG %>% kable(digits=2)| score.m | score.sd | score.se | score.ci | lower.ci | upper.ci | lower.se | upper.se |
|---|---|---|---|---|---|---|---|
| 7.96 | 0.81 | 0.18 | 0.38 | 7.58 | 8.34 | 7.78 | 8.14 |
bh_allG$x <- 1
bh_allG$x <- factor(bh_allG$x)
bh.plot1 <- ggplot(data=bh_allG, aes(x=x, y=score.m)) +
stat_summary(fun = mean, geom = "bar", position="dodge", fill="gray70",
na.rm = TRUE, alpha = .9, width = 0.7, color="black", size = 0.15) +
geom_errorbar(data=bh_allG,
aes(x = 1, y=score.m, ymin = score.m - score.ci, ymax = score.m + score.ci), width=.2,
position=position_dodge(.8), color = "black") +
geom_hline(yintercept=60, linetype='dashed', color='darkred', alpha =1, size=1) +
coord_cartesian(ylim = c(1, 9), clip = "on") +
# coord_cartesian(ylim = c(0, 5), clip = "on") +
labs(x = "Group", y = "Mean Score") +
scale_y_continuous(breaks = seq(0, 9, by = 1)) +
# scale_x_discrete(labels=c("Summary")) +
theme_bw(base_size = 18) +
theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position=c(0.8, 0.85))
# bh.plot1
bh.plot2 <- ggplot(data=bh_allL, aes(x=sn, y=score)) +
stat_summary(fun = mean, geom = "bar", position="dodge", fill="gray70",
na.rm = TRUE, alpha = .9, width = 0.8, color="black", size = 0.15) +
geom_hline(yintercept=60, linetype='dashed', color='darkred', alpha =1, size=1) +
coord_cartesian(ylim = c(1, 9), clip = "on") +
scale_y_continuous(breaks = seq(1, 9, by = 1)) +
# coord_cartesian(ylim = c(0, 5), clip = "on") +
labs(x = "Subject Number", y = "Score") +
theme_bw(base_size = 18) +
theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", size = 15, color = "black"),
axis.text.x = element_text(face = "plain", size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position=c(0.8, 0.85))
# bh.plot2
bh.plot <- ggarrange(bh.plot1, bh.plot2, ncol = 2, widths = c(1,3),
labels = c("A", "B"))
bh.plot
5 Image Quality Assessment
기능적 연결성 분석의 대상이 되는 fMRI time-course data는 스캔 중 참가자들의 움직임에 민감하다. 만약 스캔 중 과도한 움직임이 있는 경우, time-course data를 왜곡할 수 있고 기능적 연결성이 잘못 추정될 수 있다. 이를 위해 fMRI 전처리 과정에 움직임을 보정하는 단계(motion correction, denoising step)를 거치나, 움직임이 많은 경우, 보정 과정에서 과도하게 많은 데이터를 제거할 가능성이 있다. 이러한 가능성을 확인하기 위해, 각 영상의 TR 별로 Framewise Displacement를 계산하고, 사전에 정해진 역치를 초과하는지, 전/후반부 간 과도한 차이가 있는지 확인하였다.
# qa1 <- read.csv("fd_byRun_opt3.csv", header = T)
qa1 <- read.csv("data/fd_byIdx_opt3.csv", header = T)
glimpse(qa1, width = 80)
## Rows: 630
## Columns: 8
## $ sn <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
## $ run <int> 1, 10, 8, 6, 1, 6, 3, 6, 8, 3, 2, 7, 7, 4, 9, 10, 9, 8, 3, 5, …
## $ idx <int> 2, 9, 10, 13, 15, 24, 25, 33, 44, 49, 58, 62, 68, 74, 81, 86, …
## $ stim_fd <dbl> 0.05841905, 0.08808869, 0.14467205, 0.14675789, 0.06882145, 0.…
## $ p1_fd <dbl> 0.05311265, 0.08460212, 0.11705558, 0.14284837, 0.07651832, 0.…
## $ p2_fd <dbl> 0.06754991, 0.09158456, 0.15771316, 0.14960857, 0.06197980, 0.…
## $ count <int> 0, 4, 20, 19, 0, 24, 2, 21, 19, 1, 0, 0, 29, 35, 5, 4, 7, 10, …
## $ prop <dbl> 0.000000, 5.333333, 18.867925, 22.891566, 0.000000, 22.857143,…
qa1_l <- qa1 %>% filter(sn %in% targ_sn)
qa1_l$sn = factor(qa1_l$sn)
qa1_l$run = factor(qa1_l$run)
qa1_l$idx = factor(qa1_l$idx)
# qa1_l <- gather(qa1_l, key = part, value = fd, all_fd:p2_fd)
qa1_l <- gather(qa1_l, key = part, value = fd, stim_fd:p2_fd)
# qa1_l$part <- factor(qa1_l$part,
# levels = c('all_fd', 'stim_fd', 'p1_fd', 'p2_fd'),
# labels = c('all', 'stim', 'p1', 'p2'))
qa1_l$part <- factor(qa1_l$part,
levels = c('stim_fd', 'p1_fd', 'p2_fd'),
labels = c('stim', 'p1', 'p2'))
qa1_t <- qa1_l %>% dplyr::select(sn, run, idx, part, fd, count, prop)
bh_tt <- bh_t
bh_tt$idx <- bh_tt$stimIdx
bh_tt <- bh_tt %>% dplyr::select(sn, idx, corr, check)
qa1_t <- merge(qa1_t, bh_tt, by= c('sn', 'idx'))
qa1_t <- qa1_t %>% filter(check == 0) %>% filter(corr == 1)5.1 By Subject, Framewise Displacement
각 영상별 지속 시간에서 Framewise Displacement가 0.2mm를 초과하는 경우가 있는지를 참가자별로 요약하였다. 분석 결과, 평균 FD가 0.2mm 를 초과하는 참가자는 관찰되지 않았다.
# glimpse(qa1_1)
# subject-level, long format
# qa1_allL <- qa1_t %>% dplyr::filter(run == 0, part == 'stim') %>% group_by(sn) %>%
# dplyr::summarise(fd=mean(fd)) %>%
# ungroup()
qa1_allL <- qa1_t %>% dplyr::filter(part == 'stim') %>% group_by(sn) %>%
dplyr::summarise(fd=mean(fd)) %>%
ungroup()
# qa1_allL %>% kable(digits=2)
# subject-level, wide format
qa1_allG <- rstatix::get_summary_stats(qa1_allL) %>%
mutate(fd.m = mean, fd.sd = sd, fd.se = se, fd.ci = ci) %>%
dplyr::select(fd.m, fd.sd, fd.se, fd.ci)
qa1_allG <- qa1_allG %>%
mutate(lower.ci = fd.m-fd.ci,
upper.ci = fd.m+fd.ci,
lower.se = fd.m-fd.se,
upper.se = fd.m+fd.se)
qa1_allL %>% spread(key = sn, value = fd) %>% kable(digits=2)| 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 0.1 | 0.18 | 0.06 | 0.11 | 0.11 | 0.06 | 0.05 | 0.05 | 0.06 | 0.08 | 0.1 | 0.17 | 0.04 | 0.09 | 0.11 | 0.05 | 0.06 | 0.1 | 0.12 | 0.05 |
qa1_allG %>% kable(digits=2)| fd.m | fd.sd | fd.se | fd.ci | lower.ci | upper.ci | lower.se | upper.se |
|---|---|---|---|---|---|---|---|
| 0.09 | 0.04 | 0.01 | 0.02 | 0.07 | 0.11 | 0.08 | 0.1 |
qa1_allG$x <- 1
qa1_allG$x <- factor(qa1_allG$x)
qa1.plot1 <- ggplot(data=qa1_allG, aes(x=x, y=fd.m)) +
stat_summary(fun = mean, geom = "bar", position="dodge", fill="gray70",
na.rm = TRUE, alpha = .9, width = 0.7, color="black", size = 0.15) +
geom_errorbar(data=qa1_allG,
aes(x = 1, y=fd.m, ymin = fd.m - fd.ci, ymax = fd.m + fd.ci), width=.2,
position=position_dodge(.8), color = "black") +
geom_hline(yintercept=0.2, linetype='dashed', color='darkred', alpha =1, size=1) +
coord_cartesian(ylim = c(0, 0.3), clip = "on") +
# coord_cartesian(ylim = c(0, 5), clip = "on") +
labs(x = "Group", y = "Mean FD value") +
# scale_x_discrete(labels=c("Summary")) +
theme_bw(base_size = 18) +
theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position=c(0.8, 0.85))
# qa1.plot1
qa1.plot2 <- ggplot(data=qa1_allL, aes(x=sn, y=fd)) +
stat_summary(fun = mean, geom = "bar", position="dodge", fill="gray70",
na.rm = TRUE, alpha = .9, width = 0.8, color="black", size = 0.15) +
geom_hline(yintercept=0.2, linetype='dashed', color='darkred', alpha =1, size=1) +
coord_cartesian(ylim = c(0, 0.3), clip = "on") +
# coord_cartesian(ylim = c(0, 5), clip = "on") +
labs(x = "Subject Number", y = "FD value") +
theme_bw(base_size = 18) +
theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", size = 15, color = "black"),
axis.text.x = element_text(face = "plain", size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position=c(0.8, 0.85))
# qa1.plot2
qa1.plot <- ggarrange(qa1.plot1, qa1.plot2, ncol = 2, widths = c(1,3),
labels = c("A", "B"))
qa1.plot
5.2 By Subject, Proportion of Outlier TRs (FD 0.2<)
평균 FD 분석에 더하여, 영상의 TR별로 FD가 0.2mm 를 초과하는 경우가 개별 영상의 전체 지속 시간에서 어느 정도 비율을 차지하는지 참가자별로 요약하였다. FD가 0.2mm를 초과하는 TR의 비율이 50% 를 초과하는 참가자는 관찰되지 않았다.
# glimpse(qa1_1)
# subject-level, long format
# qa1_allL <- qa1_t %>% dplyr::filter(run == 0, part == 'all') %>% group_by(sn) %>%
# dplyr::summarise(prop=mean(prop)) %>%
# ungroup()
qa1_allL <- qa1_t %>% dplyr::filter(part == 'stim') %>% group_by(sn) %>%
dplyr::summarise(prop=mean(prop)) %>%
ungroup()
# qa1_allL %>% kable(digits=2)
# subject-level, wide format
qa1_allG <- rstatix::get_summary_stats(qa1_allL) %>%
mutate(prop.m = mean, prop.sd = sd, prop.se = se, prop.ci = ci) %>%
dplyr::select(prop.m, prop.sd, prop.se, prop.ci)
qa1_allG <- qa1_allG %>%
mutate(lower.ci = prop.m-prop.ci,
upper.ci = prop.m+prop.ci,
lower.se = prop.m-prop.se,
upper.se = prop.m+prop.se)
qa1_allL %>% spread(key = sn, value = prop) %>% kable(digits=2)| 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 9.78 | 21.87 | 0.03 | 7.88 | 6.98 | 0.6 | 1.53 | 0 | 0.34 | 0.66 | 0.64 | 26.66 | 0 | 2.48 | 9.61 | 0.24 | 0.94 | 4.64 | 6.78 | 0.04 |
qa1_allG %>% kable(digits=2)| prop.m | prop.sd | prop.se | prop.ci | lower.ci | upper.ci | lower.se | upper.se |
|---|---|---|---|---|---|---|---|
| 5.08 | 7.43 | 1.66 | 3.48 | 1.61 | 8.56 | 3.42 | 6.75 |
qa1_allG$x <- 1
qa1_allG$x <- factor(qa1_allG$x)
qa1.plot1 <- ggplot(data=qa1_allG, aes(x=x, y=prop.m)) +
stat_summary(fun = mean, geom = "bar", position="dodge", fill="gray70",
na.rm = TRUE, alpha = .9, width = 0.7, color="black", size = 0.15) +
geom_errorbar(data=qa1_allG,
aes(x = 1, y=prop.m, ymin = prop.m - prop.ci, ymax = prop.m + prop.ci), width=.2,
position=position_dodge(.8), color = "black") +
geom_hline(yintercept=50, linetype='dashed', color='darkred', alpha =1, size=1) +
# coord_cartesian(ylim = c(0, 0.3), clip = "on") +
# coord_cartesian(ylim = c(0, 5), clip = "on") +
labs(x = "Group", y = "Mean Proportion of Outliers (%)") +
# scale_x_discrete(labels=c("Summary")) +
theme_bw(base_size = 18) +
theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position=c(0.8, 0.85))
# qa1.plot1
qa1.plot2 <- ggplot(data=qa1_allL, aes(x=sn, y=prop)) +
stat_summary(fun = mean, geom = "bar", position="dodge", fill="gray70",
na.rm = TRUE, alpha = .9, width = 0.8, color="black", size = 0.15) +
geom_hline(yintercept=50, linetype='dashed', color='darkred', alpha =1, size=1) +
# coord_cartesian(ylim = c(0, 0.3), clip = "on") +
# coord_cartesian(ylim = c(0, 5), clip = "on") +
labs(x = "Subject Number", y = "Proportion of Outliers (%)") +
theme_bw(base_size = 18) +
theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", size = 15, color = "black"),
axis.text.x = element_text(face = "plain", size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position=c(0.8, 0.85))
# qa1.plot2
qa1.plot <- ggarrange(qa1.plot1, qa1.plot2, ncol = 2, widths = c(1,3),
labels = c("A", "B"))
qa1.plot
5.3 By Part & Subject, Framewise Displacement
각 참가자별로, 영상의 전/후반부 간 FD 값의 체계적인 차이가 있는지 확인하였다.
# subject-level, long format
qa2_t <- qa1_t %>% dplyr::filter(run != 0, part != 'all', part != 'stim')
qa2_t$part <- factor(qa2_t$part)
qa2_allL <- qa2_t %>% group_by(sn, part) %>%
dplyr::summarise(fd=mean(fd)) %>%
ungroup()
## `summarise()` has grouped output by 'sn'. You can override using the `.groups` argument.
# summary table: grand mean
qa2_allG <- qa2_allL %>% group_by(part) %>%
dplyr::summarise(fd.m = mean(fd), fd.sd = sd(fd)) %>%
ungroup()
qa2_allG$fd.se <- Rmisc::summarySEwithin(data = qa2_allL, measurevar = "fd",
idvar = "sn", withinvars = c("part"))$se
qa2_allG$fd.ci <- Rmisc::summarySEwithin(data = qa2_allL, measurevar = "fd",
idvar = "sn", withinvars = c("part"))$ci
qa2_allG <- qa2_allG %>%
mutate(lower.ci = fd.m-fd.ci,
upper.ci = fd.m+fd.ci,
lower.se = fd.m-fd.se,
upper.se = fd.m+fd.se)
qa2_allG %>% kable(digits=3)| part | fd.m | fd.sd | fd.se | fd.ci | lower.ci | upper.ci | lower.se | upper.se |
|---|---|---|---|---|---|---|---|---|
| p1 | 0.090 | 0.040 | 0.002 | 0.003 | 0.087 | 0.093 | 0.089 | 0.092 |
| p2 | 0.086 | 0.039 | 0.002 | 0.003 | 0.083 | 0.089 | 0.085 | 0.088 |
qa2.plot2 <- ggplot(data=qa2_allL, aes(x=sn, y=fd, fill=part)) +
stat_summary(fun = mean, geom = "bar", position="dodge",
na.rm = TRUE, alpha = .9, width = 0.8, color="black", size = 0.15) +
geom_hline(yintercept=0.2, linetype='dashed', color='darkred', alpha =1, size=1) +
# coord_cartesian(ylim = c(0, 0.3), clip = "on") +
# coord_cartesian(ylim = c(0, 5), clip = "on") +
scale_fill_manual(values = c("#ED7D31", "#5B9BD5"), # c("#ED7D31", "#5B9BD5", "#70AD47"),
labels = c("First Half", "Second Half")) +
# scale_fill_brewer(palette="Set2", labels = c('part 1', 'part 2')) +
labs(x = "Subject Number", y = "FD value") +
theme_bw(base_size = 18) +
theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", size = 15, color = "black"),
axis.text.x = element_text(face = "plain", size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position='top')
qa2.plot2
5.4 By Part, Framewise Displacement
영상의 전/후반부에서 FD value의 차이를 요약하였다.
# subject-level, long format
qa2_t <- qa1_t %>% dplyr::filter(run != 0, part != 'all', part != 'stim')
qa2_t$part <- factor(qa2_t$part)
qa2_allL <- qa2_t %>% group_by(sn, part) %>%
dplyr::summarise(fd=mean(fd)) %>%
ungroup()
## `summarise()` has grouped output by 'sn'. You can override using the `.groups` argument.
# subject-level, wide format
qa2_allW <- qa2_allL %>% spread(key=part, value = fd)
# qa2_allW %>% kable(digits=2)
# summary table: grand mean
qa2_allG <- qa2_allL %>% group_by(part) %>%
dplyr::summarise(fd.m = mean(fd), fd.sd = sd(fd)) %>%
ungroup()
qa2_allG$fd.se <- Rmisc::summarySEwithin(data = qa2_allL, measurevar = "fd",
idvar = "sn", withinvars = c("part"))$se
qa2_allG$fd.ci <- Rmisc::summarySEwithin(data = qa2_allL, measurevar = "fd",
idvar = "sn", withinvars = c("part"))$ci
qa2_allG <- qa2_allG %>%
mutate(lower.ci = fd.m-fd.ci,
upper.ci = fd.m+fd.ci,
lower.se = fd.m-fd.se,
upper.se = fd.m+fd.se)
qa2_allG %>% kable(digits=3)| part | fd.m | fd.sd | fd.se | fd.ci | lower.ci | upper.ci | lower.se | upper.se |
|---|---|---|---|---|---|---|---|---|
| p1 | 0.090 | 0.040 | 0.002 | 0.003 | 0.087 | 0.093 | 0.089 | 0.092 |
| p2 | 0.086 | 0.039 | 0.002 | 0.003 | 0.083 | 0.089 | 0.085 | 0.088 |
library(RColorBrewer)
# display.brewer.all()
qa2_allL.1 <- qa2_allL
qa2_allW.1 <- qa2_allW
qa2_allG.1 <- qa2_allG
qa2.p1.all.plot1 <- ggplot(data=qa2_allL.1, aes(x=part, y=fd, fill=part, shpae=part)) +
stat_summary(fun = mean, geom = "bar", position="dodge",
na.rm = TRUE, alpha = .9, width = 0.8, size = 0.15, color = "black" ) +
geom_hline(yintercept=0.2, linetype='dashed', color="gray20", alpha =1, size=1) +
geom_segment(data=filter(qa2_allW.1), inherit.aes = FALSE,
aes(x=1, y=filter(qa2_allW.1)$p1,
xend=2, yend=filter(qa2_allW.1)$p2),
color="gray90") +
geom_point(data=qa2_allL.1, aes(x=part, y=fd, fill=part), position = position_dodge(width=0.8),
size=2, show.legend=F, color="gray90") +
geom_errorbar(data=qa2_allG.1, aes(x=part, y= fd.m, ymin=fd.m-fd.ci, ymax=fd.m+fd.ci), width=.2,
position=position_dodge(.8), color = "black") +
scale_fill_manual(values = c("#ED7D31", "#5B9BD5"), # c("#ED7D31", "#5B9BD5", "#70AD47"),
labels = c("First Half", "Second Half")) +
# scale_fill_brewer(palette="Set2",labels = c('part 1', 'part 2')) +
# coord_cartesian(ylim = c(0, 100), clip = "on") +
labs(x = "Part", y = "mean FD value") +
ggtitle("By Part, Framewise Displacement") +
theme_bw(base_size = 18) +
theme(axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position="bottom")
# plot-control 3
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
qa2.p1.all.plot1
전/후반부 간 FD 값의 차이는 통계적으로 유의하지 않았다.
qa2_allL.1.tmp <- qa2_allL
qa2.aov1.tmp <- aov_ez(id="sn", dv="fd", data = qa2_allL.1.tmp, within = c("part"))
# summary(r1.aov1)
nice(qa2.aov1.tmp, es="pes") %>% kable(digits=2)| Effect | df | MSE | F | pes | p.value |
|---|---|---|---|---|---|
| part | 1, 19 | 0.00 | 3.24 + | .146 | .088 |
p_h1 <- qa2_allL.1.tmp %>%
rstatix::pairwise_t_test(fd ~ part,
p.adjust.method="holm",
paired=T, detailed=T) %>%
dplyr::select(group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- qa2_allL.1.tmp %>%
rstatix::cohens_d(fd ~ part, paired=T, ci = F) %>%
dplyr::select(group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("group1", "group2")) %>% kable(digits=3)| group1 | group2 | estimate | conf.low | conf.high | df | statistic | p.adj | p.adj.signif | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|
| p1 | p2 | 0.004 | -0.001 | 0.009 | 19 | 1.799 | 0.088 | ns | 0.402 | small |
bh_t <- bh_t %>% filter(sn %in% targ_sn)6 fMRI Results
이야기 지각 중 획득된 fMRI 뇌 영상 자료는 상기한 자료를 기반으로 전, 후반으로 분할되었고, 각 구획의 자료는 기능적 연결성 패턴(functional connectivity pattern)으로 재구성되었다.
먼저 전체 뇌의 기능적 연결성 패턴 분석을 위한 Whole-brain parcellation은 Yeo et al.2011; Yeo et al., 2015 을 따라 이루어졌다. 먼저 7개 Brain Network(Vis, SM, FPN, DAN, VAN, DMN, Limbic Network)를 기반으로 한 114개의 cortical regions를 MNI space로 변환하였다YeoLab, GitHub. Sub-cortical Regions으로 FSL MNI152 template brain에서 Freesurfer segmentation으로 추출된 8개의 ROIs(bilateral amygdala, hippocampus, thalamus, striatum)을 준비하였다. 이 ROI들은 Subcortical Network로 할당하였다. 이러한 절차를 통해 최종적으로 122개 ROIs, 8개 Network (Vis, SM, FPN, DAN, VAN, DMN, Limbic Network, Subcor) + TemporalParietal이 준비되었다.
fMRI EPI 데이터는 FSL 6.0.4과 FMRIB software libraries (Analysis Group, FMRIB, Oxford, UK; http://fsl.fmrib.ox.ac.uk)로 전처리되었다. 구체적으로 EPI 데이터의 T1 equilibration을 위해 각 scan run에서 3개의 volume(6s)을 제거하고 Slice Timing Correction과 Motion Correction을 수행하였다. 또한 128-s period cut-off의 high-pass filter로 필터링되었다. Spatial smoothing은 5-mm full-width half-maximum (FWHM) kernel로 수행되었다. 이어서 전처리된 fMRI 데이터에서 noise를 제거하기 위해 Nuisance Regression을 수행하였다. Regression에는 6개의 motion-related parameter, 각 parameter의 quadratic term 6개, 그리고 Global Mean Siganl, White-matter Mask와 Ventricle Mask에서 각각 추출된 3개의 regressors, 그리고 전체 parameter들의 temporal derivatives를 포함하여 총 30개의 regressors가 포함되었다. Nuisance regression 후 종적으로 산출된 cleaned fMRI EPI 데이터는 High-resoultion structural scan -> MNI template, EPI -> High-resolution structural scan, EPI -> MNI temlate의 과정을 통해 Registration 되었다.
결과적으로 생성된 standard MNI brain 데이터에서 각 영상의 timepoint별로 timecourse data를 추출하였다. 추출된 영상 별 timecourse data는 사전에 설정된 전/후반부로 분할되었다. 구획별 fMRI 신호의 겹침을 방지하고, 정확한 timecourse data를 추출하기 위해, 영상의 시작 부분 3TR, 영상의 전/후반부 경계의 전후의 3TR (6TR)을 제거하고, 전/후반부의 timecourse data를 추출하였다. 추출된 timecourse data는 사전에 준비된 122개 ROI에 따라 추출 및 평균화 되었다. 이에 따라 총 122개의 Timecourse가 전/후반부 별로 총 30개 영상에 대해 준비되었다.
30개 영상, 전/후반부의 122개 timecourse에서 기능적 연결성 분석을 수행하였다. 각 영상의 구획별 122개 timecourse에서 서로 간 Pearson correlation을 계산하여 122 x 122의 Connectivity Matrix를 구성하고, Fisher의 z-transformation을 통해 각 r값을 z 값으로 변환하였다. 이어서 각 matrix에서 edge들을 추출하여 영상/구획별 connectivity pattern을 추출하고 edge들에 8개 networ k + TP와 Between Network의 인덱스를 부여하였다. 이러한 과정을 통해 전체 참가자별로, 30개의 영상에 대한 전/후반후 connectivity pattern 데이터가 준비되었다.
최종 connectivity pattern에 대하여 Multivariate Pattern Analysis를 수행하였다. 이 분석은 성실히 보지 않았거나, 제대로 이해하지 못한 것으로 판정된 영상들을 제외한 나머지 영상의 패턴들을 대상으로 수행되었다. 먼저 Python 분석(aniFC_sFC_analysis.ipynb 코드 참조)을 수행하였다. Python을 활용한 분석에는 numpy, pandas, sklearn, brain connectivity toolbox 등의 package가 사용되었다. 참가자 내에서 영상별 분류가 패턴 분류가 되는지, 참가자 간에 걸쳐 패턴 분류가 되는지 확인하기 위해 Machine learning 기법으로 패턴 분류를 수행하였다. 추가로, BCT 패키지를 통해Network Analysis를 수행하여 조건/패턴별 network measure를 추출하였다. 이어서 Matlab을 통해 Representational Similarity Analysis를 수행하였다. 각 참가자 내에서 영상 내/간의 패턴 유사성을 비교하고 전체 영상에서 전/후반부 별 패턴 유사성을 비교하였다. 아래에는 위 분석에 대한 통계 분석을 수행한다.
6.1 MVPC - Classifier Check
먼저 Python 코드를 활용한 Multivariate Pattern Classification 결과를 확인한다. 첫째로 참가자 내에서 서로 다른 영상에 대하여 전/후반부에 따른 패턴 분류가 성공적으로 되는지 살펴보았다. 참가자 내 패턴 분류는 Run을 기준으로 Train & Test 셋을 구성하여 수행하였다. 구체적으로 10개 Run 중 9개 (27개 영상)를 Training Set, 1개 Run(3개 영상)을 Test Set으로 구분하고, Training & Test를 수행한다. 이 과정을 Cross-Validation Step 과 유사하게 Run 별로 10번 반복하여 10번의 정확도를 평균화하였다.분석 모델에 따른 차이를 확인하기 위해서 Ridge, Logistic Regression, SVM의 세 가지 classifier 모델을 활용하였다.
r5 <- read.csv("py_output/sFC_mvpc_subj_opt3_std2.csv", header = T)
glimpse(r5, width = 70)
## Rows: 600
## Columns: 7
## $ subj <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ net <int> 10, 10, 10, 0, 0, 0, 1, 1, 1, 2, 2, 2, 3, 3, 3, 4…
## $ classifier <int> 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2…
## $ valid_acc <dbl> 84, 84, 84, 84, 84, 84, 70, 72, 70, 58, 56, 58, 7…
## $ p1_acc <dbl> 80, 80, 80, 80, 84, 84, 64, 64, 68, 52, 48, 60, 7…
## $ p2_acc <dbl> 88, 88, 88, 88, 84, 84, 76, 80, 72, 64, 64, 56, 6…
## $ auc <dbl> 84, 84, 84, 84, 84, 84, 70, 72, 70, 58, 56, 58, 7…
r5_l <- r5 %>% filter(subj %in% targ_sn)
r5_l$sn = factor(r5_l$subj)
r5_l$netNum = factor(r5_l$net,
levels = c(10, 0, 1, 2, 3, 4, 5, 6, 7, 9),
labels = c('All', 'Btw', 'Vis', 'SM', 'FPN',
'VAN', 'DAN', 'DMN', 'Limb', 'SubCor'))
# % 0. All
# % 1. Vis
# % 2. SM
# % 3. FPN
# % 4. VAN
# % 5. DAN
# % 6. DMN
# % 7. Limbic
# % 8. TP
# % 9. SubCor
# % 10. BTW
r5_l$classf = factor(r5_l$classifier, levels=c(1,2,3),
labels = c('ridge', 'logreg', 'linearSVM'))
r5_l$acc = r5_l$valid_acc
r5_1 = r5_l %>% dplyr::select(sn, netNum, classf, acc, p1_acc, p2_acc,
auc)
table(r5_1$sn, r5_1$netNum)
##
## All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## 1 3 3 3 3 3 3 3 3 3 3
## 2 3 3 3 3 3 3 3 3 3 3
## 3 3 3 3 3 3 3 3 3 3 3
## 4 3 3 3 3 3 3 3 3 3 3
## 5 3 3 3 3 3 3 3 3 3 3
## 6 3 3 3 3 3 3 3 3 3 3
## 7 3 3 3 3 3 3 3 3 3 3
## 8 3 3 3 3 3 3 3 3 3 3
## 9 3 3 3 3 3 3 3 3 3 3
## 10 3 3 3 3 3 3 3 3 3 3
## 11 3 3 3 3 3 3 3 3 3 3
## 13 3 3 3 3 3 3 3 3 3 3
## 14 3 3 3 3 3 3 3 3 3 3
## 15 3 3 3 3 3 3 3 3 3 3
## 16 3 3 3 3 3 3 3 3 3 3
## 17 3 3 3 3 3 3 3 3 3 3
## 18 3 3 3 3 3 3 3 3 3 3
## 19 3 3 3 3 3 3 3 3 3 3
## 20 3 3 3 3 3 3 3 3 3 3
## 21 3 3 3 3 3 3 3 3 3 36.1.1 Three Classifier & Network - Accuracy
세 Classifier가 참가자 내에서 영상 간의 패턴 분류를 수행한 결과를 전체 pattern과 네트워크 별 pattern으로 요약하였다.
# glimpse(r5_1)
# subject-level, long format
r5_allL <- r5_1 %>% group_by(sn, classf, netNum) %>%
dplyr::summarise(acc=mean(acc)) %>%
ungroup()
## `summarise()` has grouped output by 'sn', 'classf'. You can override using the `.groups` argument.
# r5_allL %>% kable(digits=2)
# subject-level, wide format
r5_allW <- r5_allL %>% spread(key=netNum, value = acc)
# r5_allL %>% filter(sn==2)%>% spread(key=netNum, value = acc)
r5_allW %>% dplyr::select(sn, classf, All) %>%
spread(key=sn, value= All)%>% kable(digits=2)| classf | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| ridge | 84 | 89.66 | 88.33 | 64.58 | 67.24 | 84.48 | 77.59 | 89.66 | 77.59 | 83.33 | 69.64 | 72.22 | 88.33 | 69.23 | 72 | 79.63 | 82.14 | 75.93 | 80.77 | 73.21 |
| logreg | 84 | 86.21 | 90.00 | 64.58 | 70.69 | 84.48 | 77.59 | 87.93 | 81.03 | 83.33 | 73.21 | 70.37 | 86.67 | 67.31 | 74 | 79.63 | 82.14 | 77.78 | 80.77 | 69.64 |
| linearSVM | 84 | 91.38 | 88.33 | 64.58 | 67.24 | 84.48 | 77.59 | 87.93 | 77.59 | 81.48 | 69.64 | 72.22 | 86.67 | 67.31 | 72 | 79.63 | 82.14 | 75.93 | 82.69 | 71.43 |
# summary table: grand mean
r5_allG <- r5_allL %>% group_by(classf, netNum) %>%
dplyr::summarise(acc.m = mean(acc), acc.sd = sd(acc)) %>%
ungroup()
## `summarise()` has grouped output by 'classf'. You can override using the `.groups` argument.
r5_allG$acc.se <- Rmisc::summarySEwithin(data = r5_allL, measurevar = "acc",
idvar = "sn", withinvars = c("classf","netNum"))$se
r5_allG$acc.ci <- Rmisc::summarySEwithin(data = r5_allL, measurevar = "acc",
idvar = "sn", withinvars = c("classf","netNum"))$ci
r5_allG <- r5_allG %>%
mutate(lower.ci = acc.m-acc.ci,
upper.ci = acc.m+acc.ci,
lower.se = acc.m-acc.se,
upper.se = acc.m+acc.se)
r5_allG %>% dplyr::select(netNum, classf, acc.m) %>%
spread(key=netNum, value=acc.m) %>% kable(digits=2)| classf | All | Btw | Vis | SM | FPN | VAN | DAN | DMN | Limb | SubCor |
|---|---|---|---|---|---|---|---|---|---|---|
| ridge | 78.48 | 76.96 | 71.88 | 54.65 | 71.52 | 61.07 | 65.50 | 67.45 | 52.59 | 55.76 |
| logreg | 78.57 | 77.94 | 72.90 | 54.82 | 71.88 | 62.03 | 67.38 | 68.44 | 53.64 | 56.15 |
| linearSVM | 78.21 | 77.05 | 68.24 | 53.45 | 71.68 | 60.94 | 66.38 | 66.63 | 53.03 | 53.99 |
library(RColorBrewer)
# display.brewer.all()
r5_allL.1 <- r5_allL #%>% filter(netNum == 'All')
r5_allG.1 <- r5_allG #%>% filter(netNum == 'All')
# r5_allG.1 <- r5_allW %>% filter(netNum == 'All')
r5.p1.all.plot1 <- ggplot(data=r5_allL.1, aes(x=netNum, y=acc, fill=netNum, shpae=netNum)) +
stat_summary(fun = mean, geom = "bar", position="dodge",
na.rm = TRUE, alpha = .9, width = 0.8, size = 0.15, color = "black") +
geom_hline(yintercept=50, linetype='dashed', color="gray20", alpha =1, size=1) +
facet_grid(.~classf, scales="free_x", space = "free",
labeller = labeller(classf = c("ridge" = "ridge",
"logreg" = "logreg",
"linearSVM" = "linear\nSVM",
"rbfSVM" = "rbf\nSVM"))) +
# geom_dotplot(binaxis = "y", stackdir = "center", stackratio = 0.5,
# color = "black", alpha = 0.5, #position = "nudge",
# position = position_jitter(0.15),
# inherit.aes = TRUE, binwidth = 0.4) +
# geom_jitter(aes(x=cond, y=z, fill=cond,color = cond),
# position=position_jitter(0.1), cex=2
# ) +
geom_point(data=r5_allL.1, aes(x=netNum, y=acc, fill=netNum), position = position_dodge(width=0.8),
size=2, show.legend=F, color="gray90") +
geom_errorbar(data=r5_allG.1, aes(x=netNum, y= acc.m, ymin=acc.m-acc.ci, ymax=acc.m+acc.ci), width=.2,
position=position_dodge(.8), color = "black") +
scale_fill_brewer(palette="Set3") +
coord_cartesian(ylim = c(0, 100), clip = "on") +
labs(x = "Network", y = "Classification Accuracy") +
ggtitle("FC - Yeo122net MVPC") +
theme_bw(base_size = 18) +
theme(axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position="bottom")
# plot-control 3
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r5.p1.all.plot1
세 가지 Classifier, Network 별로 정확도가 Chance level인 50%보다 유의하게 높은지 살펴보았다.
r5_allL.1.tmp <- r5_allL
r5_allL.1.tmp$classf #<- factor(r5_allL.1.tmp$classf,
## [1] ridge ridge ridge ridge ridge ridge ridge
## [8] ridge ridge ridge logreg logreg logreg logreg
## [15] logreg logreg logreg logreg logreg logreg linearSVM
## [22] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [29] linearSVM linearSVM ridge ridge ridge ridge ridge
## [36] ridge ridge ridge ridge ridge logreg logreg
## [43] logreg logreg logreg logreg logreg logreg logreg
## [50] logreg linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [57] linearSVM linearSVM linearSVM linearSVM ridge ridge ridge
## [64] ridge ridge ridge ridge ridge ridge ridge
## [71] logreg logreg logreg logreg logreg logreg logreg
## [78] logreg logreg logreg linearSVM linearSVM linearSVM linearSVM
## [85] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM ridge
## [92] ridge ridge ridge ridge ridge ridge ridge
## [99] ridge ridge logreg logreg logreg logreg logreg
## [106] logreg logreg logreg logreg logreg linearSVM linearSVM
## [113] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [120] linearSVM ridge ridge ridge ridge ridge ridge
## [127] ridge ridge ridge ridge logreg logreg logreg
## [134] logreg logreg logreg logreg logreg logreg logreg
## [141] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [148] linearSVM linearSVM linearSVM ridge ridge ridge ridge
## [155] ridge ridge ridge ridge ridge ridge logreg
## [162] logreg logreg logreg logreg logreg logreg logreg
## [169] logreg logreg linearSVM linearSVM linearSVM linearSVM linearSVM
## [176] linearSVM linearSVM linearSVM linearSVM linearSVM ridge ridge
## [183] ridge ridge ridge ridge ridge ridge ridge
## [190] ridge logreg logreg logreg logreg logreg logreg
## [197] logreg logreg logreg logreg linearSVM linearSVM linearSVM
## [204] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [211] ridge ridge ridge ridge ridge ridge ridge
## [218] ridge ridge ridge logreg logreg logreg logreg
## [225] logreg logreg logreg logreg logreg logreg linearSVM
## [232] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [239] linearSVM linearSVM ridge ridge ridge ridge ridge
## [246] ridge ridge ridge ridge ridge logreg logreg
## [253] logreg logreg logreg logreg logreg logreg logreg
## [260] logreg linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [267] linearSVM linearSVM linearSVM linearSVM ridge ridge ridge
## [274] ridge ridge ridge ridge ridge ridge ridge
## [281] logreg logreg logreg logreg logreg logreg logreg
## [288] logreg logreg logreg linearSVM linearSVM linearSVM linearSVM
## [295] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM ridge
## [302] ridge ridge ridge ridge ridge ridge ridge
## [309] ridge ridge logreg logreg logreg logreg logreg
## [316] logreg logreg logreg logreg logreg linearSVM linearSVM
## [323] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [330] linearSVM ridge ridge ridge ridge ridge ridge
## [337] ridge ridge ridge ridge logreg logreg logreg
## [344] logreg logreg logreg logreg logreg logreg logreg
## [351] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [358] linearSVM linearSVM linearSVM ridge ridge ridge ridge
## [365] ridge ridge ridge ridge ridge ridge logreg
## [372] logreg logreg logreg logreg logreg logreg logreg
## [379] logreg logreg linearSVM linearSVM linearSVM linearSVM linearSVM
## [386] linearSVM linearSVM linearSVM linearSVM linearSVM ridge ridge
## [393] ridge ridge ridge ridge ridge ridge ridge
## [400] ridge logreg logreg logreg logreg logreg logreg
## [407] logreg logreg logreg logreg linearSVM linearSVM linearSVM
## [414] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [421] ridge ridge ridge ridge ridge ridge ridge
## [428] ridge ridge ridge logreg logreg logreg logreg
## [435] logreg logreg logreg logreg logreg logreg linearSVM
## [442] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [449] linearSVM linearSVM ridge ridge ridge ridge ridge
## [456] ridge ridge ridge ridge ridge logreg logreg
## [463] logreg logreg logreg logreg logreg logreg logreg
## [470] logreg linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [477] linearSVM linearSVM linearSVM linearSVM ridge ridge ridge
## [484] ridge ridge ridge ridge ridge ridge ridge
## [491] logreg logreg logreg logreg logreg logreg logreg
## [498] logreg logreg logreg linearSVM linearSVM linearSVM linearSVM
## [505] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM ridge
## [512] ridge ridge ridge ridge ridge ridge ridge
## [519] ridge ridge logreg logreg logreg logreg logreg
## [526] logreg logreg logreg logreg logreg linearSVM linearSVM
## [533] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [540] linearSVM ridge ridge ridge ridge ridge ridge
## [547] ridge ridge ridge ridge logreg logreg logreg
## [554] logreg logreg logreg logreg logreg logreg logreg
## [561] linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM linearSVM
## [568] linearSVM linearSVM linearSVM ridge ridge ridge ridge
## [575] ridge ridge ridge ridge ridge ridge logreg
## [582] logreg logreg logreg logreg logreg logreg logreg
## [589] logreg logreg linearSVM linearSVM linearSVM linearSVM linearSVM
## [596] linearSVM linearSVM linearSVM linearSVM linearSVM
## Levels: ridge logreg linearSVM
#levels = c("ridge", "logreg", "linearSVM"))
r5_allL.1.tmp$netNum #<- factor(r5_allL.1.tmp$netNum,
## [1] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [11] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [21] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [31] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [41] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [51] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [61] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [71] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [81] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [91] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [101] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [111] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [121] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [131] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [141] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [151] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [161] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [171] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [181] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [191] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [201] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [211] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [221] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [231] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [241] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [251] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [261] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [271] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [281] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [291] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [301] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [311] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [321] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [331] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [341] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [351] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [361] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [371] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [381] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [391] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [401] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [411] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [421] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [431] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [441] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [451] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [461] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [471] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [481] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [491] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [501] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [511] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [521] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [531] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [541] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [551] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [561] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [571] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [581] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## [591] All Btw Vis SM FPN VAN DAN DMN Limb SubCor
## Levels: All Btw Vis SM FPN VAN DAN DMN Limb SubCor
#levels = c("All", "Vis", "SM", "Control", "salvAtt", "DAN", "DMN", "Limb", "SubCor"))
p_h1 <- r5_allL.1.tmp %>% group_by(classf, netNum) %>%
rstatix::t_test(acc ~ 1, mu = 50,
detailed=T) %>%
dplyr::select(classf, netNum, group1, group2, estimate, conf.low, conf.high, df, statistic, p)
p_h2 <- r5_allL.1.tmp %>% group_by(classf, netNum) %>%
rstatix::cohens_d(acc ~ 1, mu = 50, ci = F) %>%
dplyr::select(classf, netNum, group1, group2, effsize, magnitude)
Res <- merge(p_h1, p_h2, by=c("classf", "netNum", "group1", "group2"))
as_tibble(Res[c(order(Res$classf, Res$netNum) ),]) %>%
dplyr::select(classf, netNum, group2, estimate, conf.low, conf.high, df, statistic, p ,effsize, magnitude) %>% kable(digits =3)| classf | netNum | group2 | estimate | conf.low | conf.high | df | statistic | p | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|
| ridge | All | null model | 78.478 | 74.831 | 82.126 | 19 | 16.342 | 0.000 | 3.654 | large |
| ridge | Btw | null model | 76.956 | 73.631 | 80.281 | 19 | 16.968 | 0.000 | 3.794 | large |
| ridge | Vis | null model | 71.878 | 67.788 | 75.967 | 19 | 11.197 | 0.000 | 2.504 | large |
| ridge | SM | null model | 54.653 | 50.390 | 58.916 | 19 | 2.285 | 0.034 | 0.511 | moderate |
| ridge | FPN | null model | 71.522 | 66.551 | 76.493 | 19 | 9.061 | 0.000 | 2.026 | large |
| ridge | VAN | null model | 61.067 | 57.295 | 64.838 | 19 | 6.141 | 0.000 | 1.373 | large |
| ridge | DAN | null model | 65.498 | 62.517 | 68.478 | 19 | 10.881 | 0.000 | 2.433 | large |
| ridge | DMN | null model | 67.451 | 64.355 | 70.548 | 19 | 11.796 | 0.000 | 2.638 | large |
| ridge | Limb | null model | 52.594 | 48.702 | 56.486 | 19 | 1.395 | 0.179 | 0.312 | small |
| ridge | SubCor | null model | 55.756 | 52.436 | 59.075 | 19 | 3.629 | 0.002 | 0.812 | large |
| logreg | All | null model | 78.568 | 75.111 | 82.026 | 19 | 17.296 | 0.000 | 3.867 | large |
| logreg | Btw | null model | 77.943 | 74.592 | 81.293 | 19 | 17.458 | 0.000 | 3.904 | large |
| logreg | Vis | null model | 72.900 | 68.882 | 76.917 | 19 | 11.930 | 0.000 | 2.668 | large |
| logreg | SM | null model | 54.819 | 50.495 | 59.143 | 19 | 2.332 | 0.031 | 0.522 | moderate |
| logreg | FPN | null model | 71.885 | 66.687 | 77.082 | 19 | 8.813 | 0.000 | 1.971 | large |
| logreg | VAN | null model | 62.030 | 57.900 | 66.161 | 19 | 6.096 | 0.000 | 1.363 | large |
| logreg | DAN | null model | 67.383 | 63.959 | 70.806 | 19 | 10.627 | 0.000 | 2.376 | large |
| logreg | DMN | null model | 68.442 | 65.090 | 71.793 | 19 | 11.517 | 0.000 | 2.575 | large |
| logreg | Limb | null model | 53.644 | 50.177 | 57.112 | 19 | 2.200 | 0.040 | 0.492 | small |
| logreg | SubCor | null model | 56.151 | 52.744 | 59.557 | 19 | 3.779 | 0.001 | 0.845 | large |
| linearSVM | All | null model | 78.213 | 74.513 | 81.914 | 19 | 15.958 | 0.000 | 3.568 | large |
| linearSVM | Btw | null model | 77.053 | 73.808 | 80.297 | 19 | 17.453 | 0.000 | 3.903 | large |
| linearSVM | Vis | null model | 68.242 | 63.757 | 72.727 | 19 | 8.512 | 0.000 | 1.903 | large |
| linearSVM | SM | null model | 53.455 | 50.146 | 56.763 | 19 | 2.186 | 0.042 | 0.489 | small |
| linearSVM | FPN | null model | 71.678 | 66.634 | 76.722 | 19 | 8.995 | 0.000 | 2.011 | large |
| linearSVM | VAN | null model | 60.943 | 57.132 | 64.754 | 19 | 6.010 | 0.000 | 1.344 | large |
| linearSVM | DAN | null model | 66.381 | 63.265 | 69.496 | 19 | 11.004 | 0.000 | 2.461 | large |
| linearSVM | DMN | null model | 66.635 | 63.285 | 69.984 | 19 | 10.395 | 0.000 | 2.324 | large |
| linearSVM | Limb | null model | 53.028 | 49.923 | 56.132 | 19 | 2.041 | 0.055 | 0.456 | small |
| linearSVM | SubCor | null model | 53.990 | 49.787 | 58.194 | 19 | 1.987 | 0.062 | 0.444 | small |
세 가지 Classifier에 따른 전반적인 정확도 차이가 있는지 살펴보았다.
r5_allL.1.tmp <- r5_allL %>% filter(netNum == "All")
r5.aov1.tmp <- aov_ez(id="sn", dv="acc", data = r5_allL.1.tmp, within = c("classf"))
# summary(r1.aov1)
nice(r5.aov1.tmp, es="pes") %>% kable(digits=2)| Effect | df | MSE | F | pes | p.value |
|---|---|---|---|---|---|
| classf | 1.39, 26.38 | 2.40 | 0.41 | .021 | .595 |
r5_allL.1.tmp <- r5_allL %>% filter(classf == "ridge")
r5.aov1.tmp <- aov_ez(id="sn", dv="acc", data = r5_allL.1.tmp, within = c("netNum"))
# summary(r1.aov1)
nice(r5.aov1.tmp, es="pes") %>% kable(digits=2)| Effect | df | MSE | F | pes | p.value |
|---|---|---|---|---|---|
| netNum | 5.29, 100.60 | 67.50 | 43.60 *** | .697 | <.001 |
p_h1 <- r5_allL.1.tmp %>% group_by(classf) %>%
rstatix::pairwise_t_test(acc ~ netNum,
p.adjust.method="holm",
paired=T, detailed=T) %>%
dplyr::select(classf, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r5_allL.1.tmp %>% group_by(classf) %>%
rstatix::cohens_d(acc ~ netNum, paired=T, ci = F) %>%
dplyr::select(classf, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("classf","group1", "group2")) %>% kable(digits = 3)| classf | group1 | group2 | estimate | conf.low | conf.high | df | statistic | p.adj | p.adj.signif | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|
| ridge | All | Btw | 1.522 | 0.418 | 2.626 | 19 | 2.886 | 0.114 | ns | 0.645 | moderate |
| ridge | All | DAN | 12.981 | 10.100 | 15.861 | 19 | 9.432 | 0.000 | **** | 2.109 | large |
| ridge | All | DMN | 11.027 | 7.659 | 14.395 | 19 | 6.853 | 0.000 | **** | 1.532 | large |
| ridge | All | FPN | 6.957 | 3.397 | 10.516 | 19 | 4.091 | 0.012 | * | 0.915 | large |
| ridge | All | Limb | 25.884 | 21.649 | 30.119 | 19 | 12.793 | 0.000 | **** | 2.861 | large |
| ridge | All | SM | 23.825 | 20.220 | 27.430 | 19 | 13.833 | 0.000 | **** | 3.093 | large |
| ridge | All | SubCor | 22.723 | 19.140 | 26.305 | 19 | 13.275 | 0.000 | **** | 2.968 | large |
| ridge | All | VAN | 17.412 | 12.837 | 21.987 | 19 | 7.966 | 0.000 | **** | 1.781 | large |
| ridge | All | Vis | 6.601 | 2.509 | 10.692 | 19 | 3.377 | 0.054 | ns | 0.755 | moderate |
| ridge | Btw | DAN | 11.459 | 8.370 | 14.548 | 19 | 7.764 | 0.000 | **** | 1.736 | large |
| ridge | Btw | DMN | 9.505 | 6.278 | 12.732 | 19 | 6.166 | 0.000 | *** | 1.379 | large |
| ridge | Btw | FPN | 5.435 | 1.574 | 9.295 | 19 | 2.946 | 0.112 | ns | 0.659 | moderate |
| ridge | Btw | Limb | 24.362 | 20.245 | 28.479 | 19 | 12.385 | 0.000 | **** | 2.769 | large |
| ridge | Btw | SM | 22.303 | 18.820 | 25.787 | 19 | 13.401 | 0.000 | **** | 2.996 | large |
| ridge | Btw | SubCor | 21.201 | 17.885 | 24.517 | 19 | 13.381 | 0.000 | **** | 2.992 | large |
| ridge | Btw | VAN | 15.890 | 11.637 | 20.143 | 19 | 7.820 | 0.000 | **** | 1.749 | large |
| ridge | Btw | Vis | 5.079 | 1.279 | 8.879 | 19 | 2.797 | 0.126 | ns | 0.626 | moderate |
| ridge | DAN | DMN | -1.954 | -5.777 | 1.870 | 19 | -1.070 | 1.000 | ns | -0.239 | small |
| ridge | DAN | Limb | 12.903 | 7.762 | 18.045 | 19 | 5.253 | 0.001 | *** | 1.175 | large |
| ridge | DAN | SubCor | 9.742 | 6.066 | 13.417 | 19 | 5.547 | 0.001 | *** | 1.240 | large |
| ridge | DMN | Limb | 14.857 | 10.900 | 18.814 | 19 | 7.858 | 0.000 | **** | 1.757 | large |
| ridge | DMN | SubCor | 11.696 | 8.528 | 14.863 | 19 | 7.728 | 0.000 | **** | 1.728 | large |
| ridge | FPN | DAN | 6.024 | 0.936 | 11.113 | 19 | 2.478 | 0.228 | ns | 0.554 | moderate |
| ridge | FPN | DMN | 4.070 | -0.040 | 8.181 | 19 | 2.073 | 0.365 | ns | 0.463 | small |
| ridge | FPN | Limb | 18.928 | 14.530 | 23.326 | 19 | 9.008 | 0.000 | **** | 2.014 | large |
| ridge | FPN | SubCor | 15.766 | 11.322 | 20.210 | 19 | 7.425 | 0.000 | **** | 1.660 | large |
| ridge | FPN | VAN | 10.455 | 6.007 | 14.903 | 19 | 4.920 | 0.002 | ** | 1.100 | large |
| ridge | Limb | SubCor | -3.162 | -7.317 | 0.994 | 19 | -1.592 | 0.640 | ns | -0.356 | small |
| ridge | SM | DAN | -10.844 | -14.726 | -6.963 | 19 | -5.847 | 0.000 | *** | -1.307 | large |
| ridge | SM | DMN | -12.798 | -15.708 | -9.888 | 19 | -9.205 | 0.000 | **** | -2.058 | large |
| ridge | SM | FPN | -16.869 | -20.950 | -12.787 | 19 | -8.651 | 0.000 | **** | -1.934 | large |
| ridge | SM | Limb | 2.059 | -3.013 | 7.131 | 19 | 0.850 | 1.000 | ns | 0.190 | negligible |
| ridge | SM | SubCor | -1.103 | -4.560 | 2.355 | 19 | -0.667 | 1.000 | ns | -0.149 | negligible |
| ridge | SM | VAN | -6.413 | -10.945 | -1.881 | 19 | -2.962 | 0.112 | ns | -0.662 | moderate |
| ridge | VAN | DAN | -4.431 | -9.096 | 0.234 | 19 | -1.988 | 0.368 | ns | -0.445 | small |
| ridge | VAN | DMN | -6.385 | -10.561 | -2.209 | 19 | -3.200 | 0.075 | ns | -0.716 | moderate |
| ridge | VAN | Limb | 8.472 | 4.398 | 12.547 | 19 | 4.352 | 0.007 | ** | 0.973 | large |
| ridge | VAN | SubCor | 5.311 | 0.686 | 9.935 | 19 | 2.404 | 0.239 | ns | 0.537 | moderate |
| ridge | Vis | DAN | 6.380 | 1.964 | 10.796 | 19 | 3.024 | 0.105 | ns | 0.676 | moderate |
| ridge | Vis | DMN | 4.426 | 0.243 | 8.610 | 19 | 2.215 | 0.314 | ns | 0.495 | small |
| ridge | Vis | FPN | 0.356 | -5.314 | 6.026 | 19 | 0.131 | 1.000 | ns | 0.029 | negligible |
| ridge | Vis | Limb | 19.283 | 13.507 | 25.060 | 19 | 6.987 | 0.000 | **** | 1.562 | large |
| ridge | Vis | SM | 17.224 | 12.128 | 22.320 | 19 | 7.074 | 0.000 | **** | 1.582 | large |
| ridge | Vis | SubCor | 16.122 | 12.012 | 20.231 | 19 | 8.211 | 0.000 | **** | 1.836 | large |
| ridge | Vis | VAN | 10.811 | 4.469 | 17.153 | 19 | 3.568 | 0.037 | * | 0.798 | moderate |
결과적으로 세 가지 Classifier 간의 강한 차이는 관찰되지 않았다. 따라서 아래에서는 Ridge Classifier를 사용하여 분석한 결과를 확인한다.
6.1.2 Ridge & Network & Part - Accuracy
ridge classifier, 네트워크 별로 파트 간 정확도 차이가 있는지 살펴본다.
# subject-level, long format
r5_11 <- r5_1 %>% dplyr::filter(classf == "ridge") %>% #"ridge") %>% rbfSVM
dplyr::select(sn, netNum, classf, p1_acc, p2_acc)
r5_11 <- gather(r5_11, key = part, value = acc, p1_acc:p2_acc)
r5_11$part <- factor(r5_11$part,
levels = c('p1_acc', 'p2_acc'),
labels = c('p1', 'p2'))
r5_allL <- r5_11 %>% group_by(sn, classf, netNum, part) %>%
dplyr::summarise(acc=mean(acc)) %>%
ungroup()
## `summarise()` has grouped output by 'sn', 'classf', 'netNum'. You can override using the `.groups` argument.
# r5_allL %>% kable(digits=2)
# subject-level, wide format
r5_allW <- r5_allL %>% spread(key=netNum, value = acc)
# r5_allL %>% filter(sn==2)%>% spread(key=netNum, value = acc)
r5_allW %>% dplyr::select(sn, classf, part, All) %>%
spread(key=part, value= All)%>% kable(digits=2)| sn | classf | p1 | p2 |
|---|---|---|---|
| 1 | ridge | 80.00 | 88.00 |
| 2 | ridge | 82.76 | 96.55 |
| 3 | ridge | 86.67 | 90.00 |
| 4 | ridge | 58.33 | 70.83 |
| 5 | ridge | 65.52 | 68.97 |
| 6 | ridge | 75.86 | 93.10 |
| 7 | ridge | 72.41 | 82.76 |
| 8 | ridge | 79.31 | 100.00 |
| 9 | ridge | 79.31 | 75.86 |
| 10 | ridge | 81.48 | 85.19 |
| 11 | ridge | 67.86 | 71.43 |
| 13 | ridge | 66.67 | 77.78 |
| 14 | ridge | 83.33 | 93.33 |
| 15 | ridge | 57.69 | 80.77 |
| 16 | ridge | 68.00 | 76.00 |
| 17 | ridge | 77.78 | 81.48 |
| 18 | ridge | 67.86 | 96.43 |
| 19 | ridge | 70.37 | 81.48 |
| 20 | ridge | 69.23 | 92.31 |
| 21 | ridge | 71.43 | 75.00 |
# summary table: grand mean
r5_allG <- r5_allL %>% group_by(classf, netNum, part) %>%
dplyr::summarise(acc.m = mean(acc), acc.sd = sd(acc)) %>%
ungroup()
## `summarise()` has grouped output by 'classf', 'netNum'. You can override using the `.groups` argument.
r5_allG$acc.se <- Rmisc::summarySEwithin(data = r5_allL, measurevar = "acc",
idvar = "sn", withinvars = c("classf","netNum","part"))$se
r5_allG$acc.ci <- Rmisc::summarySEwithin(data = r5_allL, measurevar = "acc",
idvar = "sn", withinvars = c("classf","netNum","part"))$ci
r5_allG <- r5_allG %>%
mutate(lower.ci = acc.m-acc.ci,
upper.ci = acc.m+acc.ci,
lower.se = acc.m-acc.se,
upper.se = acc.m+acc.se)
r5_allG %>% dplyr::select(netNum, classf, part, acc.m, acc.sd) %>% kable(digits=2)| netNum | classf | part | acc.m | acc.sd |
|---|---|---|---|---|
| All | ridge | p1 | 73.09 | 8.17 |
| All | ridge | p2 | 83.86 | 9.44 |
| Btw | ridge | p1 | 70.62 | 7.93 |
| Btw | ridge | p2 | 83.29 | 8.81 |
| Vis | ridge | p1 | 69.45 | 9.09 |
| Vis | ridge | p2 | 74.31 | 10.55 |
| SM | ridge | p1 | 53.28 | 10.14 |
| SM | ridge | p2 | 56.02 | 9.89 |
| FPN | ridge | p1 | 69.51 | 10.07 |
| FPN | ridge | p2 | 73.54 | 12.81 |
| VAN | ridge | p1 | 56.47 | 8.28 |
| VAN | ridge | p2 | 65.66 | 10.98 |
| DAN | ridge | p1 | 61.98 | 9.72 |
| DAN | ridge | p2 | 69.02 | 6.68 |
| DMN | ridge | p1 | 63.97 | 7.54 |
| DMN | ridge | p2 | 70.93 | 7.29 |
| Limb | ridge | p1 | 51.36 | 10.89 |
| Limb | ridge | p2 | 53.82 | 8.45 |
| SubCor | ridge | p1 | 54.23 | 10.21 |
| SubCor | ridge | p2 | 57.28 | 9.19 |
# %>% spread(key=part, value=acc.m) library(RColorBrewer)
# display.brewer.all()
r5_allL.1 <- r5_allL #%>% filter(netNum == 'All')
r5_allG.1 <- r5_allG #%>% filter(netNum == 'All')
# r5_allG.1 <- r5_allW %>% filter(netNum == 'All')
r5.p1.all.plot1 <- ggplot(data=r5_allL.1, aes(x=part, y=acc, fill=part, shpae=part)) +
stat_summary(fun = mean, geom = "bar", position="dodge",
na.rm = TRUE, alpha = .9, width = 0.8, size = 0.15, color = "black" ) +
geom_hline(yintercept=50, linetype='dashed', color="gray20", alpha =1, size=1) +
facet_grid(.~netNum, scales="free_x", space = "free") +
# geom_dotplot(binaxis = "y", stackdir = "center", stackratio = 0.5,
# color = "black", alpha = 0.5, #position = "nudge",
# position = position_jitter(0.15),
# inherit.aes = TRUE, binwidth = 0.4) +
# geom_jitter(aes(x=cond, y=z, fill=cond,color = cond),
# position=position_jitter(0.1), cex=2
# ) +
geom_point(data=r5_allL.1, aes(x=part, y=acc, fill=part), position = position_dodge(width=0.8),
size=2, show.legend=F, color="gray90") +
geom_errorbar(data=r5_allG.1, aes(x=part, y= acc.m, ymin=acc.m-acc.ci, ymax=acc.m+acc.ci), width=.2,
position=position_dodge(.8), color = "black") +
scale_fill_manual(values = c("#ED7D31", "#5B9BD5"), # c("#ED7D31", "#5B9BD5", "#70AD47"),
labels = c("First Half", "Second Half")) +
coord_cartesian(ylim = c(0, 100), clip = "on") +
labs(x = "Part", y = "Classification Accuracy") +
ggtitle("FC - Yeo122net Ridge MVPC") +
theme_bw(base_size = 18) +
theme(axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position="bottom")
# plot-control 3
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r5.p1.all.plot1
각 파트별 정확도가 Chance level 인 50% 보다 유의하게 높은지 살펴본다.
r5_allL.1.tmp <- r5_allL
p_h1 <- r5_allL.1.tmp %>% group_by(classf, netNum, part) %>%
rstatix::t_test(acc ~ 1, mu = 50,
detailed=T) %>%
dplyr::select(classf, netNum, part, group1, group2, estimate, conf.low, conf.high, df, statistic, p)
p_h2 <- r5_allL.1.tmp %>% group_by(classf, netNum, part) %>%
rstatix::cohens_d(acc ~ 1, mu = 50, ci = F) %>%
dplyr::select(classf, netNum, part, group1, group2, effsize, magnitude)
Res <- merge(p_h1, p_h2, by=c("classf", "netNum", "part", "group1", "group2"))
Res[c(order(Res$classf, Res$netNum, Res$part) ),] %>% kable(digits =3)| classf | netNum | part | group1 | group2 | estimate | conf.low | conf.high | df | statistic | p | effsize | magnitude | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | ridge | All | p1 | 1 | null model | 73.093 | 69.271 | 76.916 | 19 | 12.644 | 0.000 | 2.827 | large |
| 2 | ridge | All | p2 | 1 | null model | 83.863 | 79.447 | 88.280 | 19 | 16.048 | 0.000 | 3.588 | large |
| 3 | ridge | Btw | p1 | 1 | null model | 70.623 | 66.911 | 74.335 | 19 | 11.630 | 0.000 | 2.600 | large |
| 4 | ridge | Btw | p2 | 1 | null model | 83.290 | 79.165 | 87.414 | 19 | 16.893 | 0.000 | 3.777 | large |
| 19 | ridge | Vis | p1 | 1 | null model | 69.450 | 65.197 | 73.703 | 19 | 9.572 | 0.000 | 2.140 | large |
| 20 | ridge | Vis | p2 | 1 | null model | 74.305 | 69.367 | 79.244 | 19 | 10.301 | 0.000 | 2.303 | large |
| 13 | ridge | SM | p1 | 1 | null model | 53.281 | 48.535 | 58.028 | 19 | 1.447 | 0.164 | 0.324 | small |
| 14 | ridge | SM | p2 | 1 | null model | 56.025 | 51.398 | 60.652 | 19 | 2.725 | 0.013 | 0.609 | moderate |
| 9 | ridge | FPN | p1 | 1 | null model | 69.505 | 64.792 | 74.219 | 19 | 8.662 | 0.000 | 1.937 | large |
| 10 | ridge | FPN | p2 | 1 | null model | 73.538 | 67.542 | 79.534 | 19 | 8.216 | 0.000 | 1.837 | large |
| 17 | ridge | VAN | p1 | 1 | null model | 56.474 | 52.601 | 60.347 | 19 | 3.498 | 0.002 | 0.782 | moderate |
| 18 | ridge | VAN | p2 | 1 | null model | 65.659 | 60.519 | 70.799 | 19 | 6.376 | 0.000 | 1.426 | large |
| 5 | ridge | DAN | p1 | 1 | null model | 61.976 | 57.426 | 66.526 | 19 | 5.509 | 0.000 | 1.232 | large |
| 6 | ridge | DAN | p2 | 1 | null model | 69.019 | 65.894 | 72.145 | 19 | 12.737 | 0.000 | 2.848 | large |
| 7 | ridge | DMN | p1 | 1 | null model | 63.970 | 60.443 | 67.497 | 19 | 8.290 | 0.000 | 1.854 | large |
| 8 | ridge | DMN | p2 | 1 | null model | 70.933 | 67.523 | 74.343 | 19 | 12.849 | 0.000 | 2.873 | large |
| 11 | ridge | Limb | p1 | 1 | null model | 51.364 | 46.267 | 56.461 | 19 | 0.560 | 0.582 | 0.125 | negligible |
| 12 | ridge | Limb | p2 | 1 | null model | 53.824 | 49.868 | 57.780 | 19 | 2.023 | 0.057 | 0.452 | small |
| 15 | ridge | SubCor | p1 | 1 | null model | 54.230 | 49.452 | 59.009 | 19 | 1.853 | 0.080 | 0.414 | small |
| 16 | ridge | SubCor | p2 | 1 | null model | 57.281 | 52.979 | 61.583 | 19 | 3.543 | 0.002 | 0.792 | moderate |
r5_allL.1.tmp <- r5_allL# %>% # filter(netNum == "All")
r5.aov1.tmp <- aov_ez(id="sn", dv="acc", data = r5_allL.1.tmp, within = c("netNum","part"))
# summary(r1.aov1)
nice(r5.aov1.tmp, es="pes") %>% kable(digits=2)| Effect | df | MSE | F | pes | p.value |
|---|---|---|---|---|---|
| netNum | 5.29, 100.60 | 134.99 | 43.60 *** | .697 | <.001 |
| part | 1, 19 | 83.84 | 48.50 *** | .719 | <.001 |
| netNum:part | 6.13, 116.40 | 62.88 | 2.98 ** | .136 | .009 |
p_h1 <- r5_allL.1.tmp %>% group_by(netNum) %>%
rstatix::pairwise_t_test(acc ~ part,
p.adjust.method="holm",
paired=T, detailed=T) %>%
dplyr::select(netNum, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r5_allL.1.tmp %>% group_by(netNum) %>%
rstatix::cohens_d(acc ~ part, paired=T, ci = F) %>%
dplyr::select(netNum, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("netNum","group1", "group2")) %>% kable(digits=3)| netNum | group1 | group2 | estimate | conf.low | conf.high | df | statistic | p.adj | p.adj.signif | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|
| All | p1 | p2 | -10.770 | -14.646 | -6.894 | 19 | -5.816 | 0.000 | **** | -1.300 | large |
| Btw | p1 | p2 | -12.667 | -16.833 | -8.501 | 19 | -6.364 | 0.000 | **** | -1.423 | large |
| DAN | p1 | p2 | -7.043 | -12.083 | -2.004 | 19 | -2.925 | 0.009 | ** | -0.654 | moderate |
| DMN | p1 | p2 | -6.963 | -10.090 | -3.836 | 19 | -4.660 | 0.000 | *** | -1.042 | large |
| FPN | p1 | p2 | -4.033 | -8.214 | 0.148 | 19 | -2.019 | 0.058 | ns | -0.451 | small |
| Limb | p1 | p2 | -2.460 | -7.221 | 2.301 | 19 | -1.081 | 0.293 | ns | -0.242 | small |
| SM | p1 | p2 | -2.743 | -6.641 | 1.154 | 19 | -1.473 | 0.157 | ns | -0.329 | small |
| SubCor | p1 | p2 | -3.051 | -9.264 | 3.163 | 19 | -1.028 | 0.317 | ns | -0.230 | small |
| VAN | p1 | p2 | -9.185 | -14.277 | -4.092 | 19 | -3.775 | 0.001 | ** | -0.844 | large |
| Vis | p1 | p2 | -4.855 | -9.104 | -0.606 | 19 | -2.391 | 0.027 | * | -0.535 | moderate |
6.2 MVPC - Ridge, All Group
이어서 전체 참가자를 대상으로 참가자 간 서로 다른 구획별 패턴이 성공적으로 분류되는지 살펴보았다. 분석 모델로는 Ridge를 사용하였다. 참가자 간 패턴 분류 결과는 아래와 같이 계산된다. 먼저 전체 20명의 참가자 중 19명을 Training set으로 구성하고, 나머지 한명을 Test set으로 구성한다. 19명의 Training Set에서는 Run 번호를 기준으로 Leave One Group Out 기법을 수행하여 Train & Validation을 수행한다. 이를 통해 모델 퍼포먼스를 확인하고 나머지 한명의 Test Set에 대하여 Test를 수행한다. 이 과정을 참가자별로 20번 반복하여 20번의 Validation & Testing Accuracy를 평균화하였다.
r7 <- read.csv("py_output/sFC_mvpc_grp_opt3_std2.csv", header = T)
glimpse(r7, width = 70)
## Rows: 200
## Columns: 17
## $ tSN <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2,…
## $ net <int> 10, 0, 1, 2, 3, 4, 5, 6, 7, 9, 10, 0, 1, 2, 3, …
## $ classifier <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
## $ vAcc <dbl> 84.72486, 83.39658, 74.19355, 54.26945, 73.1499…
## $ vAuc <dbl> 84.72486, 83.39658, 74.19355, 54.26945, 73.1499…
## $ p1_vAcc <dbl> 83.87097, 82.54269, 72.10626, 54.83871, 70.5882…
## $ p2_vAcc <dbl> 85.57875, 84.25047, 76.28083, 53.70019, 75.7115…
## $ perm_vAcc <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
## $ perm_vChance <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
## $ perm_vPval <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
## $ tAcc <dbl> 78.00000, 80.00000, 52.00000, 56.00000, 72.0000…
## $ tAuc <dbl> 78.00000, 80.00000, 52.00000, 56.00000, 72.0000…
## $ p1_tAcc <dbl> 60.00000, 68.00000, 76.00000, 44.00000, 60.0000…
## $ p2_tAcc <dbl> 96.00000, 92.00000, 28.00000, 68.00000, 84.0000…
## $ perm_tAcc <dbl> 0.8000000, 0.8000000, 0.6400000, 0.5600000, 0.7…
## $ perm_tChance <dbl> 0.5076000, 0.5120000, 0.5202000, 0.4896000, 0.4…
## $ perm_tPval <dbl> 0.00990099, 0.00990099, 0.05940594, 0.23762376,…
r7_l <- r7 %>% filter(tSN %in% targ_sn)
r7_l$tSN = factor(r7_l$tSN)
r7_l$netNum = factor(r7_l$net,
levels = c(10, 0, 1, 2, 3, 4, 5, 6, 7, 9),
labels = c('All', 'Btw', 'Vis', 'SM', 'FPN',
'VAN', 'DAN', 'DMN', 'Limb', 'SubCor'))
r7_l$net = factor(r7_l$net,
levels = c(10, 0, 1, 2, 3, 4, 5, 6, 7, 9),
labels = c('All', 'Btw', 'Vis', 'SM', 'FPN',
'VAN', 'DAN', 'DMN', 'Limb', 'SubCor'))
r7_l$classf = factor(r7_l$classifier, labels = c('Ridge'))
r7_1 <- r7_l %>% dplyr::select(tSN, net, classifier, vAcc, tAcc)
r7_1 <- gather(r7_1, type, acc, vAcc:tAcc, factor_key=TRUE)
r7_1$type <- factor(r7_1$type, levels=c("vAcc","tAcc"), labels=c("valid","test"))
r7_2 <- r7_l %>% dplyr::select(tSN, net, classifier,
p1_vAcc, p2_vAcc,
p1_tAcc, p2_tAcc)
r7_2 <- gather(r7_2, type, acc, p1_vAcc:p2_tAcc, factor_key=TRUE)
r7_2$type <- factor(r7_2$type,
levels=c("p1_vAcc","p2_vAcc","p1_tAcc","p2_tAcc"),
labels=c("p1_valid","p2_valid","p1_test","p2_test"))
r7_2 <- separate(r7_2, col=type, sep= "_", into = c("part","type"))
r7_2$type <- factor(r7_2$type, levels=c("valid","test"), labels=c("valid","test"))
r7_2$part <- factor(r7_2$part, levels=c("p1","p2"), labels=c("p1","p2"))참가자 간 분류의 Validation & Test 결과를 요약하였다.
r7_acc <- r7_l %>% dplyr::select(tSN, net, classifier, vAcc, tAcc) %>%
gather(type, acc, vAcc:tAcc, factor_key=T)
r7_acc$acc <- r7_acc$acc
r7_acc$type <- factor(r7_acc$type, levels = c("vAcc", "tAcc"),
labels = c("valid", "test"))
r7_acc %>% dplyr::filter(net=="All") %>%
dplyr::select(tSN, net, type, acc) %>% spread(key = tSN, value = acc) %>% kable(digits = 1)| net | type | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| All | valid | 84.7 | 84.6 | 85.6 | 85.3 | 85.4 | 84.6 | 83.6 | 83.5 | 84.4 | 86.4 | 82.9 | 84.0 | 84.4 | 85.1 | 85.6 | 83.9 | 84.9 | 84.0 | 84.4 | 86.2 |
| All | test | 78.0 | 77.6 | 85.0 | 56.2 | 75.9 | 89.7 | 77.6 | 65.5 | 86.2 | 68.5 | 82.1 | 70.4 | 83.3 | 82.7 | 66.0 | 74.1 | 75.0 | 88.9 | 80.8 | 71.4 |
r7_p <- r7_l %>% dplyr::select(tSN, net, classifier, perm_vPval, perm_tPval) %>%
gather(type, pVal, perm_vPval:perm_tPval, factor_key=T)
r7_p$type <- factor(r7_p$type, levels = c("perm_vPval", "perm_tPval"),
labels = c("valid", "test"))
r7_p %>% dplyr::filter(net=="All") %>%
dplyr::select(tSN, net, type, pVal) %>% spread(key = tSN, value = pVal) %>% kable(digits = 3)| net | type | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| All | valid | 0.00 | 0.00 | 0.00 | 0.00 | 0.00 | 0.00 | 0.00 | 0.00 | 0.00 | 0.00 | 0.000 | 0.00 | 0.00 | 0.00 | 0.00 | 0.00 | 0.00 | 0.00 | 0.00 | 0.00 |
| All | test | 0.01 | 0.01 | 0.01 | 0.04 | 0.02 | 0.01 | 0.01 | 0.01 | 0.01 | 0.01 | 0.059 | 0.01 | 0.01 | 0.02 | 0.01 | 0.01 | 0.01 | 0.01 | 0.01 | 0.02 |
# glimpse(r7_1)
# subject-level, long format
r7_11 <- r7_1 %>% dplyr::select(tSN, net, classifier, type, acc)
r7_allL1 <- r7_11 %>% group_by(tSN, net, type) %>%
dplyr::summarise(acc=mean(acc)) %>%
ungroup()
## `summarise()` has grouped output by 'tSN', 'net'. You can override using the `.groups` argument.
r7_allW1 <- r7_allL1 %>% spread(key=type, value=acc)
r7_allG1 <- r7_allL1 %>% group_by(net,type) %>%
dplyr::summarise(acc.m = mean(acc), acc.sd = sd(acc)) %>%
ungroup()
## `summarise()` has grouped output by 'net'. You can override using the `.groups` argument.
r7_allG1$acc.se <- Rmisc::summarySEwithin(data = r7_allL1, measurevar = "acc",
idvar = "tSN", withinvars = c("net","type"))$se
r7_allG1$acc.ci <- Rmisc::summarySEwithin(data = r7_allL1, measurevar = "acc",
idvar = "tSN", withinvars = c("net","type"))$ci
r7_allG1 <- r7_allG1 %>%
mutate(lower.ci = acc.m-acc.ci,
upper.ci = acc.m+acc.ci,
lower.se = acc.m-acc.se,
upper.se = acc.m+acc.se)
r7_allG1 %>% dplyr::select(net, type, acc.m, lower.ci, upper.ci) %>% kable(digits = 2)| net | type | acc.m | lower.ci | upper.ci |
|---|---|---|---|---|
| All | valid | 84.67 | 83.52 | 85.82 |
| All | test | 76.74 | 73.26 | 80.23 |
| Btw | valid | 82.86 | 81.81 | 83.91 |
| Btw | test | 76.42 | 73.39 | 79.44 |
| Vis | valid | 73.06 | 72.02 | 74.10 |
| Vis | test | 72.36 | 68.12 | 76.61 |
| SM | valid | 54.13 | 53.17 | 55.08 |
| SM | test | 53.40 | 50.43 | 56.36 |
| FPN | valid | 73.03 | 71.84 | 74.23 |
| FPN | test | 68.07 | 64.39 | 71.76 |
| VAN | valid | 59.87 | 58.76 | 60.97 |
| VAN | test | 57.13 | 53.83 | 60.43 |
| DAN | valid | 66.57 | 65.64 | 67.49 |
| DAN | test | 63.46 | 59.84 | 67.08 |
| DMN | valid | 64.77 | 63.67 | 65.87 |
| DMN | test | 59.45 | 56.69 | 62.22 |
| Limb | valid | 54.36 | 53.49 | 55.23 |
| Limb | test | 52.93 | 50.19 | 55.67 |
| SubCor | valid | 55.77 | 54.92 | 56.62 |
| SubCor | test | 55.60 | 52.73 | 58.47 |
# subject-level, wide format
r7_21 <- r7_2 %>% dplyr::select(tSN, net, classifier, part, type, acc)
r7_allL2 <- r7_21 %>% group_by(tSN, net, type, part) %>%
dplyr::summarise(acc=mean(acc)) %>%
ungroup()
## `summarise()` has grouped output by 'tSN', 'net', 'type'. You can override using the `.groups` argument.
r7_allL2 %>% spread(key = part, value =acc)
## # A tibble: 400 × 5
## tSN net type p1 p2
## <fct> <fct> <fct> <dbl> <dbl>
## 1 1 All valid 83.9 85.6
## 2 1 All test 60 96
## 3 1 Btw valid 82.5 84.3
## 4 1 Btw test 68 92
## 5 1 Vis valid 72.1 76.3
## 6 1 Vis test 76 28
## 7 1 SM valid 54.8 53.7
## 8 1 SM test 44 68
## 9 1 FPN valid 70.6 75.7
## 10 1 FPN test 60 84
## # … with 390 more rows
r7_allW2 <- r7_allL2 %>% spread(key = part, value =acc)
r7_allG2 <- r7_allL2 %>% group_by(net ,type, part) %>%
dplyr::summarise(acc.m = mean(acc), acc.sd = sd(acc)) %>%
ungroup()
## `summarise()` has grouped output by 'net', 'type'. You can override using the `.groups` argument.
r7_allG2$acc.se <- Rmisc::summarySEwithin(data = r7_allL2, measurevar = "acc",
idvar = "tSN", withinvars = c("net","type", "part"))$se
r7_allG2$acc.ci <- Rmisc::summarySEwithin(data = r7_allL2, measurevar = "acc",
idvar = "tSN", withinvars = c("net","type", "part"))$ci
r7_allG2 <- r7_allG2 %>%
mutate(lower.ci = acc.m-acc.ci,
upper.ci = acc.m+acc.ci,
lower.se = acc.m-acc.se,
upper.se = acc.m+acc.se)
r7_allG2 %>% dplyr::select(net, type, part, acc.m, lower.ci, upper.ci) %>% kable(digits = 2)| net | type | part | acc.m | lower.ci | upper.ci |
|---|---|---|---|---|---|
| All | valid | p1 | 82.80 | 81.61 | 83.99 |
| All | valid | p2 | 86.55 | 85.35 | 87.74 |
| All | test | p1 | 72.63 | 63.68 | 81.59 |
| All | test | p2 | 80.86 | 71.78 | 89.93 |
| Btw | valid | p1 | 80.99 | 79.82 | 82.16 |
| Btw | valid | p2 | 84.74 | 83.78 | 85.69 |
| Btw | test | p1 | 71.81 | 63.33 | 80.29 |
| Btw | test | p2 | 81.02 | 73.30 | 88.75 |
| Vis | valid | p1 | 71.80 | 70.76 | 72.83 |
| Vis | valid | p2 | 74.32 | 73.28 | 75.36 |
| Vis | test | p1 | 70.83 | 62.54 | 79.11 |
| Vis | test | p2 | 73.90 | 64.26 | 83.54 |
| SM | valid | p1 | 55.00 | 54.09 | 55.91 |
| SM | valid | p2 | 53.26 | 52.17 | 54.35 |
| SM | test | p1 | 51.41 | 41.86 | 60.96 |
| SM | test | p2 | 55.38 | 46.49 | 64.27 |
| FPN | valid | p1 | 70.41 | 69.28 | 71.55 |
| FPN | valid | p2 | 75.66 | 74.35 | 76.96 |
| FPN | test | p1 | 66.95 | 59.11 | 74.79 |
| FPN | test | p2 | 69.19 | 60.68 | 77.70 |
| VAN | valid | p1 | 58.47 | 57.39 | 59.54 |
| VAN | valid | p2 | 61.27 | 60.11 | 62.43 |
| VAN | test | p1 | 54.48 | 41.99 | 66.98 |
| VAN | test | p2 | 59.78 | 46.52 | 73.05 |
| DAN | valid | p1 | 66.24 | 65.31 | 67.17 |
| DAN | valid | p2 | 66.90 | 65.92 | 67.87 |
| DAN | test | p1 | 58.14 | 46.92 | 69.35 |
| DAN | test | p2 | 68.78 | 62.25 | 75.31 |
| DMN | valid | p1 | 63.15 | 62.04 | 64.25 |
| DMN | valid | p2 | 66.39 | 65.23 | 67.54 |
| DMN | test | p1 | 57.75 | 47.09 | 68.41 |
| DMN | test | p2 | 61.16 | 51.53 | 70.79 |
| Limb | valid | p1 | 53.61 | 52.58 | 54.64 |
| Limb | valid | p2 | 55.11 | 54.30 | 55.92 |
| Limb | test | p1 | 52.23 | 40.50 | 63.95 |
| Limb | test | p2 | 53.64 | 41.48 | 65.79 |
| SubCor | valid | p1 | 54.45 | 53.50 | 55.40 |
| SubCor | valid | p2 | 57.09 | 56.25 | 57.94 |
| SubCor | test | p1 | 53.64 | 45.42 | 61.86 |
| SubCor | test | p2 | 57.56 | 48.65 | 66.47 |
library(RColorBrewer)
# display.brewer.all()
r7_allL.1 <- r7_allL1 #%>% filter(netNum == 'All')
r7_allG.1 <- r7_allG1 #%>% filter(netNum == 'All')
# r7_allG.1 <- r7_allW %>% filter(netNum == 'All')
r7.p1.all.plot1 <- ggplot(data=r7_allL.1, aes(x=type, y=acc, fill=type, shpae=type)) +
stat_summary(fun = mean, geom = "bar", position="dodge",
na.rm = TRUE, alpha = .9, width = 0.8, size = 0.15, color = "black") +
geom_hline(yintercept=50, linetype='dashed', color="gray20", alpha =1, size=1) +
facet_grid(.~net, scales="free_x", space = "free") +
#labeller = labeller(type = c("valid" = "valid",
# "test" = "test\nSVM"))) +
# geom_dotplot(binaxis = "y", stackdir = "center", stackratio = 0.5,
# color = "black", alpha = 0.5, #position = "nudge",
# position = position_jitter(0.15),
# inherit.aes = TRUE, binwidth = 0.4) +
# geom_jitter(aes(x=cond, y=z, fill=cond,color = cond),
# position=position_jitter(0.1), cex=2
# ) +
geom_segment(data=r7_allW1, inherit.aes = FALSE,
aes(x=1, y=filter(r7_allW1)$valid,
xend=2, yend=filter(r7_allW1)$test),
color="gray90", alpha = .7) +
geom_point(data=r7_allL.1, aes(x=type, y=acc, fill=type), position = position_dodge(width=0.8),
size=2, show.legend=F, color="gray90") +
geom_errorbar(data=r7_allG.1, aes(x=type, y= acc.m, ymin=acc.m-acc.ci, ymax=acc.m+acc.ci), width=.2,
position=position_dodge(.8), color = "black") +
scale_fill_brewer(palette="Set2", labels = c('Validation','Test')) +
coord_cartesian(ylim = c(0, 100), clip = "on") +
labs(x = "Network", y = "Classification Accuracy") +
ggtitle("Group-Level, Ridge, Validation vs. Test") +
theme_bw(base_size = 18) +
theme(axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position="bottom")
# plot-control 3
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r7.p1.all.plot1
library(RColorBrewer)
# display.brewer.all()
r7_allL.2 <- r7_allL2 %>% filter(type == 'test')
r7_allW2.2 <- r7_allW2 %>% filter(type == 'test')
r7_allG.2 <- r7_allG2 %>% filter(type == 'test')
# r7_allG.2 <- r7_allW %>% filter(netNum == 'All')
r7.p1.all.plot2 <- ggplot(data=r7_allL.2, aes(x=part, y=acc, fill=part, shpae=part)) +
stat_summary(fun = mean, geom = "bar", position="dodge",
na.rm = TRUE, alpha = .9, width = 0.8, size = 0.15, color = "black") +
facet_grid(.~net, scales="free_x", space = "free") +
geom_hline(yintercept=50, linetype='dashed', color="gray20", alpha =1, size=1) +
geom_point(data=r7_allL.2, aes(x=part, y=acc, fill=part), position = position_dodge(width=0.8),
size=2, show.legend=F, color="gray90") +
geom_segment(data=r7_allW2.2, inherit.aes = FALSE,
aes(x=1, y=filter(r7_allW2.2)$p1,
xend=2, yend=filter(r7_allW2.2)$p2),
color="gray90", alpha = .7) +
geom_errorbar(data=r7_allG.2, aes(x=part, y= acc.m, ymin=acc.m-acc.se, ymax=acc.m+acc.se), width=.2,
position=position_dodge(.8), color = "black") +
scale_fill_manual(values = c("#ED7D31", "#5B9BD5"), # c("#ED7D31", "#5B9BD5", "#70AD47"),
labels = c("First Half", "Second Half")) +
coord_cartesian(ylim = c(0, 100), clip = "on") +
labs(x = "Type", y = "Test Accuracy") +
# scale_x_discrete(labels=c("Validation", "Test")) +
ggtitle("Group-Level, Ridge, First vs. Second") +
theme_bw(base_size = 18) +
theme(axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position="bottom")
# plot-control 3
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r7.p1.all.plot2
분류 결과가 Chance Level인 50% 보다 유의하게 큰지 확인하였다.
r7_allL.1.tmp <- r7_allL1
p_h1 <- r7_allL.1.tmp %>% group_by(net, type) %>%
rstatix::t_test(acc ~ 1, mu = 50,
detailed=T) %>%
dplyr::select(net, type, group1, group2, estimate, conf.low, conf.high, df, statistic, p)
p_h2 <- r7_allL.1.tmp %>% group_by(net, type) %>%
rstatix::cohens_d(acc ~ 1, mu = 50, ci = F) %>%
dplyr::select(net, type, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("net", "type", "group1", "group2")) %>% kable(digits=3)| net | type | group1 | group2 | estimate | conf.low | conf.high | df | statistic | p | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|
| All | test | 1 | null model | 76.744 | 72.715 | 80.773 | 19 | 13.894 | 0.000 | 3.107 | large |
| All | valid | 1 | null model | 84.672 | 84.249 | 85.096 | 19 | 171.508 | 0.000 | 38.350 | large |
| Btw | test | 1 | null model | 76.417 | 72.797 | 80.036 | 19 | 15.278 | 0.000 | 3.416 | large |
| Btw | valid | 1 | null model | 82.861 | 82.553 | 83.170 | 19 | 223.208 | 0.000 | 49.911 | large |
| DAN | test | 1 | null model | 63.458 | 59.883 | 67.033 | 19 | 7.880 | 0.000 | 1.762 | large |
| DAN | valid | 1 | null model | 66.567 | 66.309 | 66.825 | 19 | 134.323 | 0.000 | 30.035 | large |
| DMN | test | 1 | null model | 59.454 | 56.214 | 62.693 | 19 | 6.108 | 0.000 | 1.366 | large |
| DMN | valid | 1 | null model | 64.768 | 64.393 | 65.144 | 19 | 82.340 | 0.000 | 18.412 | large |
| FPN | test | 1 | null model | 68.071 | 64.025 | 72.117 | 19 | 9.348 | 0.000 | 2.090 | large |
| FPN | valid | 1 | null model | 73.035 | 72.599 | 73.470 | 19 | 110.743 | 0.000 | 24.763 | large |
| Limb | test | 1 | null model | 52.931 | 50.081 | 55.782 | 19 | 2.152 | 0.044 | 0.481 | small |
| Limb | valid | 1 | null model | 54.363 | 54.099 | 54.627 | 19 | 34.606 | 0.000 | 7.738 | large |
| SM | test | 1 | null model | 53.396 | 50.561 | 56.231 | 19 | 2.507 | 0.021 | 0.561 | moderate |
| SM | valid | 1 | null model | 54.128 | 53.851 | 54.406 | 19 | 31.134 | 0.000 | 6.962 | large |
| SubCor | test | 1 | null model | 55.600 | 52.637 | 58.562 | 19 | 3.956 | 0.001 | 0.885 | large |
| SubCor | valid | 1 | null model | 55.773 | 55.531 | 56.016 | 19 | 49.791 | 0.000 | 11.134 | large |
| VAN | test | 1 | null model | 57.133 | 53.514 | 60.752 | 19 | 4.125 | 0.001 | 0.922 | large |
| VAN | valid | 1 | null model | 59.867 | 59.515 | 60.220 | 19 | 58.583 | 0.000 | 13.100 | large |
| Vis | test | 1 | null model | 72.363 | 67.833 | 76.893 | 19 | 10.333 | 0.000 | 2.311 | large |
| Vis | valid | 1 | null model | 73.059 | 72.757 | 73.361 | 19 | 159.845 | 0.000 | 35.743 | large |
r7_allL.1.tmp <- r7_allL1
r7.aov1.tmp <- aov_ez(id="tSN", dv="acc", data = r7_allL.1.tmp, within = c("net","type"))
# summary(r1.aov1)
nice(r7.aov1.tmp, es="pes") %>% kable(digits=2)| Effect | df | MSE | F | pes | p.value |
|---|---|---|---|---|---|
| net | 5.26, 99.90 | 38.67 | 185.57 *** | .907 | <.001 |
| type | 1, 19 | 83.29 | 13.50 ** | .415 | .002 |
| net:type | 5.48, 104.10 | 42.41 | 2.80 * | .129 | .017 |
p_h1 <- r7_allL.1.tmp %>% group_by(net) %>%
rstatix::pairwise_t_test(acc ~ type,
p.adjust.method="holm",
paired=T, detailed=T) %>%
dplyr::select(net, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r7_allL.1.tmp %>% group_by(net) %>%
rstatix::cohens_d(acc ~ type, paired=T, ci = F) %>%
dplyr::select(net, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("net","group1", "group2")) %>% kable(digits=3)| net | group1 | group2 | estimate | conf.low | conf.high | df | statistic | p.adj | p.adj.signif | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|
| All | valid | test | 7.928 | 3.763 | 12.093 | 19 | 3.984 | 0.001 | *** | 0.891 | large |
| Btw | valid | test | 6.445 | 2.771 | 10.118 | 19 | 3.672 | 0.002 | ** | 0.821 | large |
| DAN | valid | test | 3.109 | -0.524 | 6.741 | 19 | 1.791 | 0.089 | ns | 0.401 | small |
| DMN | valid | test | 5.315 | 1.872 | 8.757 | 19 | 3.232 | 0.004 | ** | 0.723 | moderate |
| FPN | valid | test | 4.963 | 0.670 | 9.256 | 19 | 2.420 | 0.026 | * | 0.541 | moderate |
| Limb | valid | test | 1.431 | -1.509 | 4.372 | 19 | 1.019 | 0.321 | ns | 0.228 | small |
| SM | valid | test | 0.732 | -2.250 | 3.715 | 19 | 0.514 | 0.613 | ns | 0.115 | negligible |
| SubCor | valid | test | 0.174 | -2.836 | 3.184 | 19 | 0.121 | 0.905 | ns | 0.027 | negligible |
| VAN | valid | test | 2.734 | -1.081 | 6.550 | 19 | 1.500 | 0.150 | ns | 0.335 | small |
| Vis | valid | test | 0.696 | -4.078 | 5.470 | 19 | 0.305 | 0.763 | ns | 0.068 | negligible |
p_h1 <- r7_allL.1.tmp %>% group_by(type) %>%
rstatix::pairwise_t_test(acc ~ net,
p.adjust.method="holm",
paired=T, detailed=T) %>%
dplyr::select(type, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r7_allL.1.tmp %>% group_by(type) %>%
rstatix::cohens_d(acc ~ net, paired=T, ci = F) %>%
dplyr::select(type, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("type","group1", "group2")) %>% kable(digits=3)| type | group1 | group2 | estimate | conf.low | conf.high | df | statistic | p.adj | p.adj.signif | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|
| test | All | Btw | 0.328 | -1.689 | 2.345 | 19 | 0.340 | 1.000 | ns | 0.076 | negligible |
| test | All | DAN | 13.286 | 8.308 | 18.264 | 19 | 5.587 | 0.001 | *** | 1.249 | large |
| test | All | DMN | 17.291 | 13.493 | 21.088 | 19 | 9.529 | 0.000 | **** | 2.131 | large |
| test | All | FPN | 8.673 | 4.543 | 12.803 | 19 | 4.395 | 0.007 | ** | 0.983 | large |
| test | All | Limb | 23.813 | 18.749 | 28.876 | 19 | 9.843 | 0.000 | **** | 2.201 | large |
| test | All | SM | 23.348 | 18.481 | 28.215 | 19 | 10.042 | 0.000 | **** | 2.245 | large |
| test | All | SubCor | 21.145 | 16.610 | 25.679 | 19 | 9.760 | 0.000 | **** | 2.182 | large |
| test | All | VAN | 19.611 | 14.796 | 24.427 | 19 | 8.524 | 0.000 | **** | 1.906 | large |
| test | All | Vis | 4.381 | -0.402 | 9.165 | 19 | 1.917 | 0.774 | ns | 0.429 | small |
| test | Btw | DAN | 12.958 | 8.550 | 17.367 | 19 | 6.152 | 0.000 | *** | 1.376 | large |
| test | Btw | DMN | 16.963 | 13.279 | 20.647 | 19 | 9.638 | 0.000 | **** | 2.155 | large |
| test | Btw | FPN | 8.345 | 4.635 | 12.055 | 19 | 4.708 | 0.004 | ** | 1.053 | large |
| test | Btw | Limb | 23.485 | 18.991 | 27.979 | 19 | 10.938 | 0.000 | **** | 2.446 | large |
| test | Btw | SM | 23.021 | 18.389 | 27.652 | 19 | 10.404 | 0.000 | **** | 2.326 | large |
| test | Btw | SubCor | 20.817 | 16.716 | 24.918 | 19 | 10.623 | 0.000 | **** | 2.375 | large |
| test | Btw | VAN | 19.284 | 14.992 | 23.576 | 19 | 9.404 | 0.000 | **** | 2.103 | large |
| test | Btw | Vis | 4.054 | -0.833 | 8.940 | 19 | 1.736 | 0.978 | ns | 0.388 | small |
| test | DAN | DMN | 4.005 | -0.907 | 8.916 | 19 | 1.707 | 0.978 | ns | 0.382 | small |
| test | DAN | Limb | 10.527 | 5.454 | 15.599 | 19 | 4.343 | 0.007 | ** | 0.971 | large |
| test | DAN | SubCor | 7.859 | 2.157 | 13.560 | 19 | 2.885 | 0.161 | ns | 0.645 | moderate |
| test | DMN | Limb | 6.522 | 3.205 | 9.840 | 19 | 4.115 | 0.011 | * | 0.920 | large |
| test | DMN | SubCor | 3.854 | -0.010 | 7.718 | 19 | 2.088 | 0.606 | ns | 0.467 | small |
| test | FPN | DAN | 4.613 | 0.622 | 8.604 | 19 | 2.419 | 0.360 | ns | 0.541 | moderate |
| test | FPN | DMN | 8.618 | 4.531 | 12.704 | 19 | 4.414 | 0.007 | ** | 0.987 | large |
| test | FPN | Limb | 15.140 | 10.445 | 19.835 | 19 | 6.750 | 0.000 | **** | 1.509 | large |
| test | FPN | SubCor | 12.472 | 6.875 | 18.068 | 19 | 4.664 | 0.004 | ** | 1.043 | large |
| test | FPN | VAN | 10.938 | 6.140 | 15.736 | 19 | 4.772 | 0.003 | ** | 1.067 | large |
| test | Limb | SubCor | -2.668 | -5.875 | 0.539 | 19 | -1.741 | 0.978 | ns | -0.389 | small |
| test | SM | DAN | -10.062 | -14.824 | -5.300 | 19 | -4.422 | 0.007 | ** | -0.989 | large |
| test | SM | DMN | -6.057 | -10.510 | -1.605 | 19 | -2.848 | 0.165 | ns | -0.637 | moderate |
| test | SM | FPN | -14.675 | -19.469 | -9.882 | 19 | -6.408 | 0.000 | *** | -1.433 | large |
| test | SM | Limb | 0.465 | -3.670 | 4.599 | 19 | 0.235 | 1.000 | ns | 0.053 | negligible |
| test | SM | SubCor | -2.204 | -6.668 | 2.261 | 19 | -1.033 | 1.000 | ns | -0.231 | small |
| test | SM | VAN | -3.737 | -8.410 | 0.936 | 19 | -1.674 | 0.978 | ns | -0.374 | small |
| test | VAN | DAN | -6.325 | -11.924 | -0.727 | 19 | -2.365 | 0.374 | ns | -0.529 | moderate |
| test | VAN | DMN | -2.321 | -6.335 | 1.694 | 19 | -1.210 | 1.000 | ns | -0.271 | small |
| test | VAN | Limb | 4.201 | 0.631 | 7.772 | 19 | 2.463 | 0.352 | ns | 0.551 | moderate |
| test | VAN | SubCor | 1.533 | -1.801 | 4.868 | 19 | 0.962 | 1.000 | ns | 0.215 | small |
| test | Vis | DAN | 8.905 | 2.705 | 15.104 | 19 | 3.006 | 0.131 | ns | 0.672 | moderate |
| test | Vis | DMN | 12.909 | 8.807 | 17.011 | 19 | 6.587 | 0.000 | **** | 1.473 | large |
| test | Vis | FPN | 4.291 | -2.132 | 10.714 | 19 | 1.398 | 1.000 | ns | 0.313 | small |
| test | Vis | Limb | 19.431 | 14.246 | 24.617 | 19 | 7.843 | 0.000 | **** | 1.754 | large |
| test | Vis | SM | 18.967 | 13.741 | 24.192 | 19 | 7.597 | 0.000 | **** | 1.699 | large |
| test | Vis | SubCor | 16.763 | 12.205 | 21.322 | 19 | 7.697 | 0.000 | **** | 1.721 | large |
| test | Vis | VAN | 15.230 | 10.115 | 20.345 | 19 | 6.232 | 0.000 | *** | 1.394 | large |
| valid | All | Btw | 1.811 | 1.453 | 2.169 | 19 | 10.592 | 0.000 | **** | 2.368 | large |
| valid | All | DAN | 18.106 | 17.556 | 18.655 | 19 | 68.958 | 0.000 | **** | 15.419 | large |
| valid | All | DMN | 19.904 | 19.357 | 20.451 | 19 | 76.137 | 0.000 | **** | 17.025 | large |
| valid | All | FPN | 11.638 | 11.057 | 12.219 | 19 | 41.950 | 0.000 | **** | 9.380 | large |
| valid | All | Limb | 30.309 | 29.799 | 30.820 | 19 | 124.191 | 0.000 | **** | 27.770 | large |
| valid | All | SM | 30.544 | 29.997 | 31.091 | 19 | 116.812 | 0.000 | **** | 26.120 | large |
| valid | All | SubCor | 28.899 | 28.521 | 29.277 | 19 | 160.051 | 0.000 | **** | 35.788 | large |
| valid | All | VAN | 24.805 | 24.259 | 25.352 | 19 | 94.978 | 0.000 | **** | 21.238 | large |
| valid | All | Vis | 11.613 | 11.095 | 12.131 | 19 | 46.933 | 0.000 | **** | 10.494 | large |
| valid | Btw | DAN | 16.295 | 15.814 | 16.775 | 19 | 71.012 | 0.000 | **** | 15.879 | large |
| valid | Btw | DMN | 18.093 | 17.681 | 18.506 | 19 | 91.777 | 0.000 | **** | 20.522 | large |
| valid | Btw | FPN | 9.827 | 9.309 | 10.345 | 19 | 39.722 | 0.000 | **** | 8.882 | large |
| valid | Btw | Limb | 28.498 | 28.062 | 28.935 | 19 | 136.577 | 0.000 | **** | 30.539 | large |
| valid | Btw | SM | 28.733 | 28.301 | 29.165 | 19 | 139.266 | 0.000 | **** | 31.141 | large |
| valid | Btw | SubCor | 27.088 | 26.772 | 27.403 | 19 | 179.692 | 0.000 | **** | 40.180 | large |
| valid | Btw | VAN | 22.994 | 22.489 | 23.499 | 19 | 95.316 | 0.000 | **** | 21.313 | large |
| valid | Btw | Vis | 9.802 | 9.403 | 10.202 | 19 | 51.312 | 0.000 | **** | 11.474 | large |
| valid | DAN | DMN | 1.799 | 1.314 | 2.284 | 19 | 7.762 | 0.000 | **** | 1.736 | large |
| valid | DAN | Limb | 12.204 | 11.875 | 12.533 | 19 | 77.581 | 0.000 | **** | 17.348 | large |
| valid | DAN | SubCor | 10.793 | 10.395 | 11.191 | 19 | 56.736 | 0.000 | **** | 12.686 | large |
| valid | DMN | Limb | 10.405 | 9.824 | 10.986 | 19 | 37.494 | 0.000 | **** | 8.384 | large |
| valid | DMN | SubCor | 8.995 | 8.546 | 9.443 | 19 | 42.003 | 0.000 | **** | 9.392 | large |
| valid | FPN | DAN | 6.468 | 5.979 | 6.956 | 19 | 27.709 | 0.000 | **** | 6.196 | large |
| valid | FPN | DMN | 8.266 | 7.763 | 8.769 | 19 | 34.401 | 0.000 | **** | 7.692 | large |
| valid | FPN | Limb | 18.672 | 18.137 | 19.206 | 19 | 73.150 | 0.000 | **** | 16.357 | large |
| valid | FPN | SubCor | 17.261 | 16.700 | 17.822 | 19 | 64.388 | 0.000 | **** | 14.398 | large |
| valid | FPN | VAN | 13.167 | 12.752 | 13.583 | 19 | 66.362 | 0.000 | **** | 14.839 | large |
| valid | Limb | SubCor | -1.411 | -1.789 | -1.032 | 19 | -7.808 | 0.000 | **** | -1.746 | large |
| valid | SM | DAN | -12.438 | -12.841 | -12.036 | 19 | -64.694 | 0.000 | **** | -14.466 | large |
| valid | SM | DMN | -10.640 | -11.120 | -10.159 | 19 | -46.336 | 0.000 | **** | -10.361 | large |
| valid | SM | FPN | -18.906 | -19.379 | -18.434 | 19 | -83.747 | 0.000 | **** | -18.726 | large |
| valid | SM | Limb | -0.235 | -0.646 | 0.177 | 19 | -1.192 | 0.496 | ns | -0.266 | small |
| valid | SM | SubCor | -1.645 | -2.059 | -1.231 | 19 | -8.313 | 0.000 | **** | -1.859 | large |
| valid | SM | VAN | -5.739 | -6.097 | -5.380 | 19 | -33.486 | 0.000 | **** | -7.488 | large |
| valid | VAN | DAN | -6.700 | -7.149 | -6.250 | 19 | -31.198 | 0.000 | **** | -6.976 | large |
| valid | VAN | DMN | -4.901 | -5.443 | -4.359 | 19 | -18.918 | 0.000 | **** | -4.230 | large |
| valid | VAN | Limb | 5.504 | 5.054 | 5.954 | 19 | 25.608 | 0.000 | **** | 5.726 | large |
| valid | VAN | SubCor | 4.094 | 3.606 | 4.582 | 19 | 17.556 | 0.000 | **** | 3.926 | large |
| valid | Vis | DAN | 6.492 | 6.134 | 6.850 | 19 | 37.954 | 0.000 | **** | 8.487 | large |
| valid | Vis | DMN | 8.291 | 7.885 | 8.696 | 19 | 42.801 | 0.000 | **** | 9.571 | large |
| valid | Vis | FPN | 0.025 | -0.466 | 0.515 | 19 | 0.105 | 0.918 | ns | 0.023 | negligible |
| valid | Vis | Limb | 18.696 | 18.241 | 19.151 | 19 | 86.060 | 0.000 | **** | 19.243 | large |
| valid | Vis | SM | 18.931 | 18.631 | 19.230 | 19 | 132.451 | 0.000 | **** | 29.617 | large |
| valid | Vis | SubCor | 17.286 | 16.870 | 17.701 | 19 | 87.123 | 0.000 | **** | 19.481 | large |
| valid | Vis | VAN | 13.192 | 12.757 | 13.627 | 19 | 63.449 | 0.000 | **** | 14.188 | large |
r7_allL.1.tmp <- r7_allL2
p_h1 <- r7_allL.1.tmp %>% group_by(net, type, part) %>%
rstatix::t_test(acc ~ 1, mu = 50,
detailed=T) %>%
dplyr::select(net, type, part, group1, group2, estimate, conf.low, conf.high, df, statistic, p)
p_h2 <- r7_allL.1.tmp %>% group_by(net, type, part) %>%
rstatix::cohens_d(acc ~ 1, mu = 50, ci = F) %>%
dplyr::select(net, type, part, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("net","type", "part", "group1", "group2")) %>% kable(digits=3)| net | type | part | group1 | group2 | estimate | conf.low | conf.high | df | statistic | p | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| All | test | p1 | 1 | null model | 72.631 | 63.328 | 81.934 | 19 | 5.091 | 0.000 | 1.138 | large |
| All | test | p2 | 1 | null model | 80.857 | 71.842 | 89.872 | 19 | 7.164 | 0.000 | 1.602 | large |
| All | valid | p1 | 1 | null model | 82.799 | 82.194 | 83.404 | 19 | 113.457 | 0.000 | 25.370 | large |
| All | valid | p2 | 1 | null model | 86.546 | 86.048 | 87.043 | 19 | 153.725 | 0.000 | 34.374 | large |
| Btw | test | p1 | 1 | null model | 71.810 | 63.040 | 80.580 | 19 | 5.205 | 0.000 | 1.164 | large |
| Btw | test | p2 | 1 | null model | 81.023 | 73.267 | 88.779 | 19 | 8.372 | 0.000 | 1.872 | large |
| Btw | valid | p1 | 1 | null model | 80.987 | 80.540 | 81.435 | 19 | 144.877 | 0.000 | 32.396 | large |
| Btw | valid | p2 | 1 | null model | 84.736 | 84.380 | 85.091 | 19 | 204.650 | 0.000 | 45.761 | large |
| DAN | test | p1 | 1 | null model | 58.135 | 47.252 | 69.019 | 19 | 1.565 | 0.134 | 0.350 | small |
| DAN | test | p2 | 1 | null model | 68.781 | 61.962 | 75.600 | 19 | 5.765 | 0.000 | 1.289 | large |
| DAN | valid | p1 | 1 | null model | 66.238 | 65.848 | 66.627 | 19 | 87.271 | 0.000 | 19.514 | large |
| DAN | valid | p2 | 1 | null model | 66.896 | 66.526 | 67.266 | 19 | 95.570 | 0.000 | 21.370 | large |
| DMN | test | p1 | 1 | null model | 57.749 | 46.759 | 68.740 | 19 | 1.476 | 0.156 | 0.330 | small |
| DMN | test | p2 | 1 | null model | 61.158 | 51.832 | 70.483 | 19 | 2.504 | 0.021 | 0.560 | moderate |
| DMN | valid | p1 | 1 | null model | 63.147 | 62.665 | 63.629 | 19 | 57.070 | 0.000 | 12.761 | large |
| DMN | valid | p2 | 1 | null model | 66.389 | 65.892 | 66.886 | 19 | 68.986 | 0.000 | 15.426 | large |
| FPN | test | p1 | 1 | null model | 66.953 | 59.104 | 74.801 | 19 | 4.521 | 0.000 | 1.011 | large |
| FPN | test | p2 | 1 | null model | 69.190 | 60.481 | 77.899 | 19 | 4.612 | 0.000 | 1.031 | large |
| FPN | valid | p1 | 1 | null model | 70.413 | 69.992 | 70.834 | 19 | 101.566 | 0.000 | 22.711 | large |
| FPN | valid | p2 | 1 | null model | 75.656 | 75.032 | 76.280 | 19 | 86.058 | 0.000 | 19.243 | large |
| Limb | test | p1 | 1 | null model | 52.226 | 40.764 | 63.688 | 19 | 0.407 | 0.689 | 0.091 | negligible |
| Limb | test | p2 | 1 | null model | 53.637 | 41.441 | 65.833 | 19 | 0.624 | 0.540 | 0.140 | negligible |
| Limb | valid | p1 | 1 | null model | 53.614 | 53.108 | 54.120 | 19 | 14.961 | 0.000 | 3.345 | large |
| Limb | valid | p2 | 1 | null model | 55.112 | 54.769 | 55.455 | 19 | 31.193 | 0.000 | 6.975 | large |
| SM | test | p1 | 1 | null model | 51.412 | 42.176 | 60.648 | 19 | 0.320 | 0.753 | 0.072 | negligible |
| SM | test | p2 | 1 | null model | 55.380 | 46.435 | 64.325 | 19 | 1.259 | 0.223 | 0.281 | small |
| SM | valid | p1 | 1 | null model | 54.996 | 54.627 | 55.366 | 19 | 28.315 | 0.000 | 6.331 | large |
| SM | valid | p2 | 1 | null model | 53.261 | 52.758 | 53.764 | 19 | 13.566 | 0.000 | 3.034 | large |
| SubCor | test | p1 | 1 | null model | 53.638 | 45.431 | 61.846 | 19 | 0.928 | 0.365 | 0.207 | small |
| SubCor | test | p2 | 1 | null model | 57.561 | 48.742 | 66.380 | 19 | 1.794 | 0.089 | 0.401 | small |
| SubCor | valid | p1 | 1 | null model | 54.452 | 54.027 | 54.878 | 19 | 21.886 | 0.000 | 4.894 | large |
| SubCor | valid | p2 | 1 | null model | 57.095 | 56.740 | 57.449 | 19 | 41.877 | 0.000 | 9.364 | large |
| VAN | test | p1 | 1 | null model | 54.484 | 41.739 | 67.228 | 19 | 0.736 | 0.471 | 0.165 | negligible |
| VAN | test | p2 | 1 | null model | 59.782 | 46.863 | 72.702 | 19 | 1.585 | 0.130 | 0.354 | small |
| VAN | valid | p1 | 1 | null model | 58.466 | 58.081 | 58.851 | 19 | 46.016 | 0.000 | 10.290 | large |
| VAN | valid | p2 | 1 | null model | 61.268 | 60.808 | 61.729 | 19 | 51.201 | 0.000 | 11.449 | large |
| Vis | test | p1 | 1 | null model | 70.826 | 62.480 | 79.172 | 19 | 5.223 | 0.000 | 1.168 | large |
| Vis | test | p2 | 1 | null model | 73.900 | 64.170 | 83.629 | 19 | 5.141 | 0.000 | 1.150 | large |
| Vis | valid | p1 | 1 | null model | 71.796 | 71.484 | 72.107 | 19 | 146.563 | 0.000 | 32.772 | large |
| Vis | valid | p2 | 1 | null model | 74.322 | 73.932 | 74.713 | 19 | 130.297 | 0.000 | 29.135 | large |
네트워크 별, 타입 별 (Valid vs. Test)로 정확도 차이가 있는지 살펴본다.
r7_allL.1.tmp <- r7_allL2
r7.aov1.tmp <- aov_ez(id="tSN", dv="acc", data = r7_allL.1.tmp, within = c("net","type", "part"))
# summary(r1.aov1)
nice(r7.aov1.tmp, es="pes") %>% kable(digits=2)| Effect | df | MSE | F | pes | p.value |
|---|---|---|---|---|---|
| net | 5.26, 99.90 | 77.35 | 185.57 *** | .907 | <.001 |
| type | 1, 19 | 166.57 | 13.50 ** | .415 | .002 |
| part | 1, 19 | 520.96 | 5.51 * | .225 | .030 |
| net:type | 5.48, 104.10 | 84.81 | 2.80 * | .129 | .017 |
| net:part | 5.35, 101.57 | 607.31 | 0.18 | .010 | .974 |
| type:part | 1, 19 | 516.67 | 0.71 | .036 | .411 |
| net:type:part | 5.39, 102.36 | 599.58 | 0.20 | .010 | .970 |
p_h1 <- r7_allL.1.tmp %>% group_by(net, part) %>%
rstatix::pairwise_t_test(acc ~ type,
p.adjust.method="holm",
paired=T, detailed=T) %>%
dplyr::select(net, part, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r7_allL.1.tmp %>% group_by(net ,part) %>%
rstatix::cohens_d(acc ~ type, paired=T, ci = F) %>%
dplyr::select(net, part, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("net","part", "group1", "group2")) %>% kable(digits=3)| net | part | group1 | group2 | estimate | conf.low | conf.high | df | statistic | p.adj | p.adj.signif | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| All | p1 | valid | test | 10.168 | 0.874 | 19.462 | 19 | 2.290 | 0.034 | * | 0.512 | moderate |
| All | p2 | valid | test | 5.689 | -3.380 | 14.758 | 19 | 1.313 | 0.205 | ns | 0.294 | small |
| Btw | p1 | valid | test | 9.177 | 0.387 | 17.968 | 19 | 2.185 | 0.042 | * | 0.489 | small |
| Btw | p2 | valid | test | 3.712 | -4.130 | 11.555 | 19 | 0.991 | 0.334 | ns | 0.222 | small |
| DAN | p1 | valid | test | 8.102 | -2.765 | 18.969 | 19 | 1.560 | 0.135 | ns | 0.349 | small |
| DAN | p2 | valid | test | -1.885 | -8.730 | 4.961 | 19 | -0.576 | 0.571 | ns | -0.129 | negligible |
| DMN | p1 | valid | test | 5.398 | -5.617 | 16.412 | 19 | 1.026 | 0.318 | ns | 0.229 | small |
| DMN | p2 | valid | test | 5.231 | -4.081 | 14.544 | 19 | 1.176 | 0.254 | ns | 0.263 | small |
| FPN | p1 | valid | test | 3.460 | -4.529 | 11.449 | 19 | 0.907 | 0.376 | ns | 0.203 | small |
| FPN | p2 | valid | test | 6.466 | -2.494 | 15.426 | 19 | 1.511 | 0.147 | ns | 0.338 | small |
| Limb | p1 | valid | test | 1.388 | -9.923 | 12.699 | 19 | 0.257 | 0.800 | ns | 0.057 | negligible |
| Limb | p2 | valid | test | 1.475 | -10.719 | 13.669 | 19 | 0.253 | 0.803 | ns | 0.057 | negligible |
| SM | p1 | valid | test | 3.584 | -5.760 | 12.929 | 19 | 0.803 | 0.432 | ns | 0.180 | negligible |
| SM | p2 | valid | test | -2.120 | -11.092 | 6.852 | 19 | -0.494 | 0.627 | ns | -0.111 | negligible |
| SubCor | p1 | valid | test | 0.814 | -7.374 | 9.003 | 19 | 0.208 | 0.837 | ns | 0.047 | negligible |
| SubCor | p2 | valid | test | -0.466 | -9.257 | 8.324 | 19 | -0.111 | 0.913 | ns | -0.025 | negligible |
| VAN | p1 | valid | test | 3.982 | -8.756 | 16.721 | 19 | 0.654 | 0.521 | ns | 0.146 | negligible |
| VAN | p2 | valid | test | 1.486 | -11.576 | 14.548 | 19 | 0.238 | 0.814 | ns | 0.053 | negligible |
| Vis | p1 | valid | test | 0.970 | -7.506 | 9.446 | 19 | 0.239 | 0.813 | ns | 0.054 | negligible |
| Vis | p2 | valid | test | 0.423 | -9.574 | 10.420 | 19 | 0.089 | 0.930 | ns | 0.020 | negligible |
p_h1 <- r7_allL.1.tmp %>% group_by(net, type) %>%
rstatix::pairwise_t_test(acc ~ part,
p.adjust.method="holm",
paired=T, detailed=T) %>%
dplyr::select(net, type, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r7_allL.1.tmp %>% group_by(net, type) %>%
rstatix::cohens_d(acc ~ part, paired=T, ci = F) %>%
dplyr::select(net, type, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("net","type", "group1", "group2")) %>% kable(digits=3)| net | type | group1 | group2 | estimate | conf.low | conf.high | df | statistic | p.adj | p.adj.signif | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| All | test | p1 | p2 | -8.226 | -24.679 | 8.227 | 19 | -1.046 | 0.308 | ns | -0.234 | small |
| All | valid | p1 | p2 | -3.747 | -4.462 | -3.032 | 19 | -10.969 | 0.000 | **** | -2.453 | large |
| Btw | test | p1 | p2 | -9.214 | -24.105 | 5.677 | 19 | -1.295 | 0.211 | ns | -0.290 | small |
| Btw | valid | p1 | p2 | -3.748 | -4.271 | -3.225 | 19 | -15.004 | 0.000 | **** | -3.355 | large |
| DAN | test | p1 | p2 | -10.645 | -27.342 | 6.052 | 19 | -1.334 | 0.198 | ns | -0.298 | small |
| DAN | valid | p1 | p2 | -0.659 | -1.216 | -0.101 | 19 | -2.473 | 0.023 | * | -0.553 | moderate |
| DMN | test | p1 | p2 | -3.408 | -22.735 | 15.918 | 19 | -0.369 | 0.716 | ns | -0.083 | negligible |
| DMN | valid | p1 | p2 | -3.242 | -3.871 | -2.613 | 19 | -10.785 | 0.000 | **** | -2.412 | large |
| FPN | test | p1 | p2 | -2.237 | -16.708 | 12.233 | 19 | -0.324 | 0.750 | ns | -0.072 | negligible |
| FPN | valid | p1 | p2 | -5.243 | -5.855 | -4.631 | 19 | -17.931 | 0.000 | **** | -4.010 | large |
| Limb | test | p1 | p2 | -1.411 | -24.383 | 21.562 | 19 | -0.129 | 0.899 | ns | -0.029 | negligible |
| Limb | valid | p1 | p2 | -1.498 | -2.182 | -0.814 | 19 | -4.582 | 0.000 | *** | -1.025 | large |
| SM | test | p1 | p2 | -3.968 | -21.245 | 13.308 | 19 | -0.481 | 0.636 | ns | -0.108 | negligible |
| SM | valid | p1 | p2 | 1.736 | 1.049 | 2.422 | 19 | 5.294 | 0.000 | **** | 1.184 | large |
| SubCor | test | p1 | p2 | -3.923 | -19.897 | 12.051 | 19 | -0.514 | 0.613 | ns | -0.115 | negligible |
| SubCor | valid | p1 | p2 | -2.642 | -3.257 | -2.027 | 19 | -8.989 | 0.000 | **** | -2.010 | large |
| VAN | test | p1 | p2 | -5.299 | -29.921 | 19.323 | 19 | -0.450 | 0.658 | ns | -0.101 | negligible |
| VAN | valid | p1 | p2 | -2.802 | -3.275 | -2.329 | 19 | -12.398 | 0.000 | **** | -2.772 | large |
| Vis | test | p1 | p2 | -3.074 | -18.776 | 12.629 | 19 | -0.410 | 0.687 | ns | -0.092 | negligible |
| Vis | valid | p1 | p2 | -2.527 | -2.893 | -2.160 | 19 | -14.425 | 0.000 | **** | -3.226 | large |
6.3 Representational Similarity Analysis
분류 분석 결과를 보충하기 위해 연결성 패턴에 대한 RSA 분석을 Matlab으로 수행하였다. 결과적으로 산출된 패턴 유사성에 대한 통계 분석을 수행한다.
r1 <- read.csv("data/r1_p1_sum_opt3.csv", header = T)
glimpse(r1, width = 70)
## Rows: 6,300
## Columns: 13
## $ sn <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
## $ stimIdx <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2,…
## $ netLabel <chr> "all_net", "1. Visual", "2. SM", "3. Control", "4.…
## $ netNum <int> 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0, 1, 2, 3, 4, 5, 6,…
## $ nNode <int> 122, 10, 10, 26, 24, 14, 24, 4, 2, 8, 122, 10, 10,…
## $ wn_p12 <dbl> 0.51648812, 0.57755802, 0.79987237, 0.52463983, 0.…
## $ btw_allTC <dbl> 0.60738852, 0.68024602, 0.80848798, 0.65970557, 0.…
## $ btw_p1 <dbl> 0.4937307, 0.5697070, 0.7125933, 0.5346186, 0.6272…
## $ btw_p2 <dbl> 0.43224876, 0.52106184, 0.73739015, 0.47575150, 0.…
## $ btw_p12 <dbl> 0.47115401, 0.54201473, 0.70614239, 0.52909839, 0.…
## $ btw_p21 <dbl> 0.418809920, 0.581627503, 0.738730401, 0.457762519…
## $ run <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 10, 10, 10, 10, 10, …
## $ order <int> 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,…
r1_l <- r1 %>% filter(sn %in% targ_sn)
r1_l$sn = factor(r1_l$sn)
r1_l$stimIdx = factor(r1_l$stimIdx)
r1_l$netLabel = factor(r1_l$netLabel,
levels = c('all_net',
'1. Visual',
'2. SM',
'3. Control',
'4. Sal/vAtt',
'5. DAN',
'6. DMN',
'7. Limbic',
'8. TP',
'9. SubCor'),
labels = c('All','Vis','SM','FPN','VAN','DAN','DMN','Limb','TP','SubCor'))
r1_l$netNum = factor(r1_l$netNum)
r1_l$run = factor(r1_l$run)
r1_l$order = factor(r1_l$order)
r1_l <- merge(r1_l, bh_t, by= c('sn', 'stimIdx'))
r1_l <- r1_l %>% filter(check == 0) %>% filter(corr == 1)
r1_1 = r1_l %>% dplyr::select(sn, stimIdx, netLabel, netNum, nNode, run, order,
wn_p12, btw_p12, btw_p21)
r1_2 = r1_l %>% dplyr::select(sn, stimIdx, netLabel, netNum, nNode, run, order,
btw_allTC, btw_p1, btw_p2)
r1_3 = r1_l %>% dplyr::select(sn, stimIdx, netLabel, netNum, nNode, run, order,
btw_p1, btw_p2, btw_p12, btw_p21)
r1_1 <- gather(r1_1, key = type, value = r_type, wn_p12:btw_p21)
r1_1$type <- factor(r1_1$type,
levels = c('wn_p12',
'btw_p12', 'btw_p21'),
labels = c('self12',
'other12',
'other21'))
r1_2 <- gather(r1_2, key = part, value = r_part, btw_allTC:btw_p2)
r1_2$part <- factor(r1_2$part,
levels = c("btw_allTC", "btw_p1", "btw_p2"),
labels = c('all', 'p1', 'p2'))
r1_3 <- gather(r1_3, key = part, value = r_part, btw_p1:btw_p21)
r1_3$part <- factor(r1_3$part,
levels = c("btw_p1", "btw_p2",
"btw_p12",
"btw_p21"),
labels = c('p1_wn', 'p2_wn',
'p1_2', 'p2_1'))6.3.1 RSA : Within Stim vs. Between Stim
먼저 각 영상별로 고유한 패턴이 있는지 확인하기 위해 within 영상, between 영상 간 패턴 유사성을 비교하였다.
# glimpse(r1_1)
# subject-level, long format
r1_allL <- r1_1 %>% group_by(sn, netLabel, type) %>%
dplyr::summarise(r=mean(r_type)) %>%
ungroup()
## `summarise()` has grouped output by 'sn', 'netLabel'. You can override using the `.groups` argument.
# r1_allL %>% kable(digits=2)
# subject-level, wide format
r1_allW <- r1_allL %>% spread(key=type, value = r)
r1_allL.1 <- r1_allW %>% mutate(self = (self12),
other = (other12+other21)/2) %>%
dplyr::select(sn, netLabel, self, other) %>%
gather(key = type, value = r, self:other, factor_key = T)
r1_allW.1 <- r1_allL.1 %>% spread(key=type, value = r)
# r1_allW.1 %>% dplyr::filter(netLabel == "all_net") %>% kable(digits=2)
# r1_allL.1 %>% filter(sn == 2) %>% spread(key=type, value = r)
# summary table: grand mean
r1_allG <- r1_allL.1 %>% group_by(netLabel, type) %>%
dplyr::summarise(r.m = mean(r), r.sd = sd(r)) %>%
ungroup()
## `summarise()` has grouped output by 'netLabel'. You can override using the `.groups` argument.
r1_allG$r.se <- Rmisc::summarySEwithin(data = r1_allL.1, measurevar = "r",
idvar = "sn", withinvars = c("netLabel","type"))$se
r1_allG$r.ci <- Rmisc::summarySEwithin(data = r1_allL.1, measurevar = "r",
idvar = "sn", withinvars = c("netLabel","type"))$ci
r1_allG <- r1_allG %>%
mutate(lower.ci = r.m-r.ci,
upper.ci = r.m+r.ci,
lower.se = r.m-r.se,
upper.se = r.m+r.se)
r1_allG %>% dplyr::select(netLabel, type, r.m) %>%
spread(key=type, value=r.m) %>% kable(digits=2)| netLabel | self | other |
|---|---|---|
| All | 0.49 | 0.46 |
| Vis | 0.72 | 0.71 |
| SM | 0.69 | 0.67 |
| FPN | 0.55 | 0.52 |
| VAN | 0.56 | 0.52 |
| DAN | 0.63 | 0.63 |
| DMN | 0.54 | 0.52 |
| Limb | 0.41 | 0.36 |
| TP | 0.02 | 0.03 |
| SubCor | 0.67 | 0.65 |
within 영상, between 영상 간 패턴 유사성을 요약하였다.
r1_allL <- r1_1 %>% group_by(sn, netNum, type) %>%
dplyr::summarise(r=mean(r_type)) %>%
ungroup()## `summarise()` has grouped output by 'sn', 'netNum'. You can override using the `.groups` argument.# r1_allL %>% kable(digits=2)
# subject-level, wide format
r1_allW <- r1_allL %>% spread(key=type, value = r)
r1_allL.1 <- r1_allW %>% mutate(self = (self12),
other = (other12+other21)/2) %>%
dplyr::select(sn, netNum, self, other) %>%
gather(key = type, value = r, self:other, factor_key = T)
r1_allW.1 <- r1_allL.1 %>% spread(key=type, value = r)
# r1_allL.1 %>% filter(netNum == 0) %>% spread(key=type, value = r)
# summary table: grand mean
r1_allG <- r1_allL.1 %>% group_by(netNum, type) %>%
dplyr::summarise(r.m = mean(r), r.sd = sd(r)) %>%
ungroup()## `summarise()` has grouped output by 'netNum'. You can override using the `.groups` argument.r1_allG$r.se <- Rmisc::summarySEwithin(data = r1_allL.1, measurevar = "r",
idvar = "sn", withinvars = c("netNum","type"))$se
r1_allG$r.ci <- Rmisc::summarySEwithin(data = r1_allL.1, measurevar = "r",
idvar = "sn", withinvars = c("netNum","type"))$ci
r1_allG <- r1_allG %>%
mutate(lower.ci = r.m-r.ci,
upper.ci = r.m+r.ci,
lower.se = r.m-r.se,
upper.se = r.m+r.se)
# plot 1
targNet = c(0)
r1_allL.p1 <- r1_allL.1 %>% filter(netNum %in% targNet)
r1_allW.p1 <- r1_allW.1 %>% filter(netNum %in% targNet)
r1_allG.p1 <- r1_allG %>% filter(netNum %in% targNet)
r1.p1.all.plot1 <- ggplot(data=r1_allL.p1, aes(x=type, y=r, fill=type, shpae=type)) +
stat_summary(fun = mean, geom = "bar", position="dodge",
na.rm = TRUE, alpha = .9, width = 0.8, color="black", size = 0.15) +
# geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
facet_grid(.~netNum, scales="free_x", space = "free",
labeller = labeller(netNum = c("0" = "All",
"1" = "Vis",
"2" = "SM",
"3" = "Cont",
"4" = "sal/VAtt",
"5" = "DAN",
"6" = "DMN",
"7" = "Limb",
"8" = "TP",
"9" = "SubCor"))) +
geom_point(data=r1_allL.p1, aes(x=type, y=r, fill=type), position = position_dodge(width=0.8),
size=2, show.legend=F, color="gray90") +
geom_segment(data=filter(r1_allW.p1), inherit.aes = FALSE,
aes(x=1, y=filter(r1_allW.p1)$self,
xend=2, yend=filter(r1_allW.p1)$other),
color="gray90") +
geom_errorbar(data=r1_allG.p1, aes(x=type, y= r.m, ymin=r.m-r.ci, ymax=r.m+r.ci), width=.2,
position=position_dodge(.8), color = "black") +
scale_x_discrete(labels=c("Within Stim", "Others")) +
scale_fill_manual(values = c("#F17402", "#2C57AA"), # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
labels = c("Within Stim", "Others")) +
scale_color_manual(values = c("#F17402", "#2C57AA"), # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
labels = c("Within Stim", "Others")) +
coord_cartesian(ylim = c(-0.2, 0.7), clip = "on") +
labs(x = "Type", y = "Functional Connectivity (FC)") +
ggtitle("FC - Yeo122net RSA") +
theme_bw(base_size = 18) +
theme(#axis.text.x=element_blank(),
#axis.ticks.x=element_blank(),
axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position="bottom")
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r1.p1.all.plot1
# plot 2
targNet = c(1, 2, 3, 4, 5, 6, 7, 8, 9)
r1_allL.p2 <- r1_allL.1 %>% filter(netNum %in% targNet)
r1_allW.p2 <- r1_allW.1 %>% filter(netNum %in% targNet)
r1_allG.p2 <- r1_allG %>% filter(netNum %in% targNet)
r1.p1.all.plot2 <- ggplot(data=r1_allL.p2, aes(x=type, y=r, fill=type, shpae=type)) +
stat_summary(fun = mean, geom = "bar", position="dodge",
na.rm = TRUE, alpha = .9, width = 0.8, color="black", size = 0.15) +
geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
facet_grid(.~netNum, scales="free_x", space = "free",
labeller = labeller(netNum = c("0" = "All",
"1" = "Vis",
"2" = "SM",
"3" = "Cont",
"4" = "sal/VAtt",
"5" = "DAN",
"6" = "DMN",
"7" = "Limb",
"8" = "TP",
"9" = "SubCor"))) +
geom_point(data=r1_allL.p2, aes(x=type, y=r, fill=type), position = position_dodge(width=0.8),
size=2, show.legend=F, color="gray90") +
geom_segment(data=filter(r1_allW.p2), inherit.aes = FALSE,
aes(x=1, y=filter(r1_allW.p2)$self,
xend=2, yend=filter(r1_allW.p2)$other),
color="gray90") +
geom_errorbar(data=r1_allG.p2, aes(x=type, y= r.m, ymin=r.m-r.ci, ymax=r.m+r.ci), width=.2,
position=position_dodge(.8), color = "black") +
scale_x_discrete(labels=c("Within Stim", "Others")) +
scale_fill_manual(values = c("#F17402", "#2C57AA"), # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
labels = c("Within Stim", "Others")) +
scale_color_manual(values = c("#F17402", "#2C57AA"), # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
labels = c("Within Stim", "Others")) +
coord_cartesian(ylim = c(-0.5, 1), clip = "on") +
labs(x = "Type", y = "Functional Connectivity (FC)") +
ggtitle("FC - Yeo122net RSA") +
theme_bw(base_size = 18) +
theme(axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position="bottom")
# plot-control 3
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r1.p1.all.plot2
전체 네트워크에서 within 영상, between 영상 간 패턴 유사성이 유의한 차이를 보이는지 확인하였다.
r1_allL.1.tmp <- r1_allL.1 %>% filter(netNum == 0)
r1.aov1.tmp <- aov_ez(id="sn", dv="r", data = r1_allL.1.tmp, within = c("type"))
# summary(r1.aov1)
nice(r1.aov1.tmp, es="pes") %>% kable(digits=2)| Effect | df | MSE | F | pes | p.value |
|---|---|---|---|---|---|
| type | 1, 19 | 0.00 | 34.80 *** | .647 | <.001 |
p_h1 <- r1_allL.1.tmp %>%
rstatix::pairwise_t_test(r ~ type,
p.adjust.method="holm",
paired=T, detailed=T) %>%
dplyr::select(group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r1_allL.1.tmp %>% # group_by(rep) %>%
rstatix::cohens_d(r ~ type, paired=T, ci = F) %>%
dplyr::select(group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("group1", "group2")) %>% kable(digits=3)| group1 | group2 | estimate | conf.low | conf.high | df | statistic | p.adj | p.adj.signif | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|
| self | other | 0.032 | 0.021 | 0.044 | 19 | 5.899 | 0 | **** | 1.319 | large |
6.3.2 RSA : Within Part vs Between Part
이어서 참가자 간에서 각 영상 간 전/후반부의 패턴 유사성을 확인한다. 구체적으로 여러 영상에 걸친 전/후반부 각각의 패턴 유사성을 Within으로 두고, 서로 다른 영상, 파트 간의 유사성을 Between으로 두어 통계 분석을 수행하였다. 먼저 요약치를 확인한다.
# subject-level, long format
r3_allL <- r1_3 %>% group_by(sn, netLabel, part) %>%
dplyr::summarise(r=mean(r_part)) %>%
ungroup()
## `summarise()` has grouped output by 'sn', 'netLabel'. You can override using the `.groups` argument.
# r3_allL %>% kable(digits=2)
# subject-level, wide format
r3_allW <- r3_allL %>% spread(key=part, value = r)
r3_allL.1 <- r3_allW %>% mutate(p1_self = p1_wn,
p2_self = p2_wn,
p1_other = (p1_2),
p2_other = (p2_1)) %>%
dplyr::select(sn, netLabel, p1_self, p2_self, p1_other, p2_other) %>%
gather(key = part, value = r, p1_self:p2_other, factor_key = T) %>%
separate(col = part, sep="_", into =c('part','type'))
r3_allL.1$part <- factor(r3_allL.1$part)
r3_allL.1$type <- factor(r3_allL.1$type, levels = c('self','other'))
# r3_allL.1 %>% filter(sn == 2) %>% spread(key=part, value = r)
r3_allL.1 %>% dplyr::filter(netLabel == "all_net") %>%
spread(key = part, value = r) %>% kable(digits=2)| sn | netLabel | type |
|---|
# summary table: grand mean
r3_allG <- r3_allL.1 %>% group_by(netLabel, part, type) %>%
dplyr::summarise(r.m = mean(r), r.sd = sd(r)) %>%
ungroup()
## `summarise()` has grouped output by 'netLabel', 'part'. You can override using the `.groups` argument.
r3_allG$r.se <- Rmisc::summarySEwithin(data = r3_allL.1, measurevar = "r",
idvar = "sn", withinvars = c("netLabel","part","type"))$se
r3_allG$r.ci <- Rmisc::summarySEwithin(data = r3_allL.1, measurevar = "r",
idvar = "sn", withinvars = c("netLabel","part","type"))$ci
r3_allG <- r3_allG %>%
mutate(lower.ci = r.m-r.ci,
upper.ci = r.m+r.ci,
lower.se = r.m-r.se,
upper.se = r.m+r.se)
r3_allG %>% dplyr::select(netLabel, part, type, r.m) %>%
spread(key=type, value=r.m) %>% kable(digits=2)| netLabel | part | self | other |
|---|---|---|---|
| All | p1 | 0.46 | 0.45 |
| All | p2 | 0.49 | 0.47 |
| Vis | p1 | 0.72 | 0.69 |
| Vis | p2 | 0.71 | 0.73 |
| SM | p1 | 0.67 | 0.66 |
| SM | p2 | 0.69 | 0.68 |
| FPN | p1 | 0.53 | 0.51 |
| FPN | p2 | 0.55 | 0.53 |
| VAN | p1 | 0.51 | 0.51 |
| VAN | p2 | 0.56 | 0.53 |
| DAN | p1 | 0.61 | 0.62 |
| DAN | p2 | 0.66 | 0.64 |
| DMN | p1 | 0.50 | 0.50 |
| DMN | p2 | 0.56 | 0.54 |
| Limb | p1 | 0.35 | 0.36 |
| Limb | p2 | 0.41 | 0.36 |
| TP | p1 | 0.03 | 0.03 |
| TP | p2 | 0.03 | 0.03 |
| SubCor | p1 | 0.63 | 0.63 |
| SubCor | p2 | 0.68 | 0.67 |
# subject-level, long format
r3_allL <- r1_3 %>% group_by(sn, netNum, part) %>%
dplyr::summarise(r=mean(r_part)) %>%
ungroup()## `summarise()` has grouped output by 'sn', 'netNum'. You can override using the `.groups` argument.# r3_allL %>% kable(digits=2)
# subject-level, wide format
r3_allW <- r3_allL %>% spread(key=part, value = r)
r3_allL.1 <- r3_allW %>% mutate(p1_self = p1_wn,
p2_self = p2_wn,
p1_other = (p1_2),
p2_other = (p2_1)) %>%
dplyr::select(sn, netNum, p1_self, p2_self, p1_other, p2_other) %>%
gather(key = part, value = r, p1_self:p2_other, factor_key = T) %>%
separate(col = part, sep="_", into =c('part','type'))
r3_allL.1$part <- factor(r3_allL.1$part)
r3_allL.1$type <- factor(r3_allL.1$type, levels = c('self','other'))
r3_allW.1 <- r3_allL.1 %>% spread(key=type, value = r)
# summary table: grand mean
r3_allG <- r3_allL.1 %>% group_by(netNum, part, type) %>%
dplyr::summarise(r.m = mean(r), r.sd = sd(r)) %>%
ungroup()## `summarise()` has grouped output by 'netNum', 'part'. You can override using the `.groups` argument.r3_allG$r.se <- Rmisc::summarySEwithin(data = r3_allL.1, measurevar = "r",
idvar = "sn", withinvars = c("netNum","part","type"))$se
r3_allG$r.ci <- Rmisc::summarySEwithin(data = r3_allL.1, measurevar = "r",
idvar = "sn", withinvars = c("netNum","part","type"))$ci
r3_allG <- r3_allG %>%
mutate(lower.ci = r.m-r.ci,
upper.ci = r.m+r.ci,
lower.se = r.m-r.se,
upper.se = r.m+r.se)
# plot 1
targNet = c(0)
r3_allL.p1 <- r3_allL.1 %>% filter(netNum %in% targNet)
r3_allW.p1 <- r3_allW.1 %>% filter(netNum %in% targNet)
r3_allG.p1 <- r3_allG %>% filter(netNum %in% targNet)
r3.p1.all.plot1 <- ggplot(data=r3_allL.p1, aes(x=part, y=r, fill=type, shpae=type)) +
stat_summary(fun = mean, geom = "bar", position="dodge",
na.rm = TRUE, alpha = .9, width = 0.8, color="black", size = 0.15) +
geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
facet_grid(.~netNum, scales="free_x", space = "free",
labeller = labeller(netNum = c("0" = "All",
"1" = "Vis",
"2" = "SM",
"3" = "Cont",
"4" = "sal/VAtt",
"5" = "DAN",
"6" = "DMN",
"7" = "Limb",
"8" = "TP",
"9" = "SubCor"))) +
geom_point(data=r3_allL.p1, aes(x=part, y=r, fill=type), position = position_dodge(width=0.8),
size=2, show.legend=F, color="gray90") +
geom_segment(data=filter(r3_allW.p1, part == "p1"), inherit.aes = FALSE,
aes(x=0.8, y=filter(r3_allW.p1, part == "p1")$self,
xend=1.2, yend=filter(r3_allW.p1, part == "p1")$other),
color="gray90") +
geom_segment(data=filter(r3_allW.p1, part == "p2"), inherit.aes = FALSE,
aes(x=1.8, y=filter(r3_allW.p1, part == "p2")$self,
xend=2.2, yend=filter(r3_allW.p1, part == "p2")$other),
color="gray90") +
geom_errorbar(data=r3_allG.p1, aes(x=part, y= r.m, ymin=r.m-r.ci, ymax=r.m+r.ci), width=.2,
position=position_dodge(.8), color = "black") +
scale_x_discrete(labels=c("Part 1","Part 2")) +
scale_fill_manual(values = c("#F17402", "#2C57AA"), # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
labels = c("Within", "Between")) +
scale_color_manual(values = c("#F17402", "#2C57AA"), # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
labels = c("Within", "Between")) +
coord_cartesian(ylim = c(-0.2, 0.7), clip = "on") +
labs(x = "Part", y = "Functional Connectivity (FC)") +
ggtitle("FC - Yeo122net RSA") +
theme_bw(base_size = 18) +
theme(#axis.text.x=element_blank(),
#axis.ticks.x=element_blank(),
axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position="bottom")
# plot-control 3
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r3.p1.all.plot1
# plot 2
targNet = c(1, 2, 3, 4, 5, 6, 7, 8, 9)
r3_allL.p1 <- r3_allL.1 %>% filter(netNum %in% targNet)
r3_allW.p1 <- r3_allW.1 %>% filter(netNum %in% targNet)
r3_allG.p1 <- r3_allG %>% filter(netNum %in% targNet)
r3.p1.all.plot2 <- ggplot(data=r3_allL.p1, aes(x=part, y=r, fill=type, shpae=type)) +
stat_summary(fun = mean, geom = "bar", position="dodge",
na.rm = TRUE, alpha = .9, width = 0.8, color="black", size = 0.15) +
geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
facet_grid(.~netNum, scales="free_x", space = "free",
labeller = labeller(netNum = c("0" = "All",
"1" = "Vis",
"2" = "SM",
"3" = "Cont",
"4" = "sal/VAtt",
"5" = "DAN",
"6" = "DMN",
"7" = "Limb",
"8" = "TP",
"9" = "SubCor"))) +
geom_point(data=r3_allL.p1, aes(x=part, y=r, fill=type), position = position_dodge(width=0.8),
size=2, show.legend=F, color="gray90") +
geom_segment(data=filter(r3_allW.p1, part == "p1"), inherit.aes = FALSE,
aes(x=0.8, y=filter(r3_allW.p1, part == "p1")$self,
xend=1.2, yend=filter(r3_allW.p1, part == "p1")$other),
color="gray90") +
geom_segment(data=filter(r3_allW.p1, part == "p2"), inherit.aes = FALSE,
aes(x=1.8, y=filter(r3_allW.p1, part == "p2")$self,
xend=2.2, yend=filter(r3_allW.p1, part == "p2")$other),
color="gray90") +
geom_errorbar(data=r3_allG.p1, aes(x=part, y= r.m, ymin=r.m-r.ci, ymax=r.m+r.ci), width=.2,
position=position_dodge(.8), color = "black") +
scale_x_discrete(labels=c("Part 1","Part 2")) +
scale_fill_manual(values = c("#F17402", "#2C57AA"), # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
labels = c("Within", "Between")) +
scale_color_manual(values = c("#F17402", "#2C57AA"), # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
labels = c("Within", "Between")) +
# coord_cartesian(ylim = c(-0.2, 0.7), clip = "on") +
labs(x = "Part", y = "Functional Connectivity (FC)") +
ggtitle("FC - Yeo122net RSA") +
theme_bw(base_size = 18) +
theme(#axis.text.x=element_blank(),
#axis.ticks.x=element_blank(),
axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position="bottom")
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r3.p1.all.plot2
각 구획 (전/후반부)과 유형 (Within(Self), Between(Other))을 요인으로 통계 분석을 수행하였다.
r3_allL.1.tmp <- r3_allL.1 %>% filter(netNum == 0)
r3.aov1.tmp <- aov_ez(id="sn", dv="r", data = r3_allL.1.tmp, within = c("part","type"))
# summary(r1.aov1)
nice(r3.aov1.tmp, es="pes") %>% kable(digits=2)| Effect | df | MSE | F | pes | p.value |
|---|---|---|---|---|---|
| part | 1, 19 | 0.00 | 17.54 *** | .480 | <.001 |
| type | 1, 19 | 0.00 | 59.43 *** | .758 | <.001 |
| part:type | 1, 19 | 0.00 | 2.47 | .115 | .133 |
p_h1 <- r3_allL.1.tmp %>% group_by(part) %>%
rstatix::pairwise_t_test(r ~ type,
p.adjust.method="holm",
paired=T, detailed=T) %>%
dplyr::select(part, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r3_allL.1.tmp %>% group_by(part) %>%
rstatix::cohens_d(r ~ type, paired=T, ci = F) %>%
dplyr::select(part, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("part","group1", "group2")) %>% kable(digits=3)| part | group1 | group2 | estimate | conf.low | conf.high | df | statistic | p.adj | p.adj.signif | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|
| p1 | self | other | 0.011 | 0.002 | 0.020 | 19 | 2.453 | 0.024 | * | 0.549 | moderate |
| p2 | self | other | 0.020 | 0.015 | 0.025 | 19 | 8.981 | 0.000 | **** | 2.008 | large |
p_h1 <- r3_allL.1.tmp %>% group_by(type) %>%
rstatix::pairwise_t_test(r ~ part,
p.adjust.method="holm",
paired=T, detailed=T) %>%
dplyr::select(type, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r3_allL.1.tmp %>% group_by(type) %>%
rstatix::cohens_d(r ~ part, paired=T, ci = F) %>%
dplyr::select(type, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("type","group1", "group2")) %>% kable(digits=3)| type | group1 | group2 | estimate | conf.low | conf.high | df | statistic | p.adj | p.adj.signif | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|
| other | p1 | p2 | -0.024 | -0.035 | -0.013 | 19 | -4.614 | 0.000 | *** | -1.032 | large |
| self | p1 | p2 | -0.033 | -0.052 | -0.014 | 19 | -3.636 | 0.002 | ** | -0.813 | large |
r3_allL.1.tmp <- r3_allL.1# %>% filter(netNum == 0)
r3.aov1.tmp <- aov_ez(id="sn", dv="r", data = r3_allL.1.tmp, within = c("netNum","part","type"))
# summary(r1.aov1)
nice(r3.aov1.tmp, es="pes") %>% kable(digits=2)| Effect | df | MSE | F | pes | p.value |
|---|---|---|---|---|---|
| netNum | 3.34, 63.55 | 0.05 | 163.12 *** | .896 | <.001 |
| part | 1, 19 | 0.01 | 20.99 *** | .525 | <.001 |
| type | 1, 19 | 0.00 | 42.46 *** | .691 | <.001 |
| netNum:part | 3.09, 58.76 | 0.01 | 1.29 | .063 | .288 |
| netNum:type | 2.37, 45.10 | 0.00 | 1.79 | .086 | .173 |
| part:type | 1, 19 | 0.00 | 4.78 * | .201 | .042 |
| netNum:part:type | 2.68, 50.95 | 0.00 | 5.09 ** | .211 | .005 |
p_h1 <- r3_allL.1.tmp %>% group_by(netNum, part) %>%
rstatix::pairwise_t_test(r ~ type,
p.adjust.method="holm",
paired=T, detailed=T) %>%
dplyr::select(netNum, part, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r3_allL.1.tmp %>% group_by(netNum, part) %>%
rstatix::cohens_d(r ~ type, paired=T, ci = F) %>%
dplyr::select(netNum, part, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("netNum","part","group1", "group2")) %>% kable(digits=3)| netNum | part | group1 | group2 | estimate | conf.low | conf.high | df | statistic | p.adj | p.adj.signif | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 0 | p1 | self | other | 0.011 | 0.002 | 0.020 | 19 | 2.453 | 0.024 | * | 0.549 | moderate |
| 0 | p2 | self | other | 0.020 | 0.015 | 0.025 | 19 | 8.981 | 0.000 | **** | 2.008 | large |
| 1 | p1 | self | other | 0.031 | 0.019 | 0.044 | 19 | 5.440 | 0.000 | **** | 1.216 | large |
| 1 | p2 | self | other | -0.019 | -0.030 | -0.008 | 19 | -3.475 | 0.003 | ** | -0.777 | moderate |
| 2 | p1 | self | other | 0.006 | -0.004 | 0.017 | 19 | 1.342 | 0.195 | ns | 0.300 | small |
| 2 | p2 | self | other | 0.009 | 0.001 | 0.017 | 19 | 2.316 | 0.032 | * | 0.518 | moderate |
| 3 | p1 | self | other | 0.015 | 0.003 | 0.027 | 19 | 2.657 | 0.016 | * | 0.594 | moderate |
| 3 | p2 | self | other | 0.024 | 0.018 | 0.031 | 19 | 7.608 | 0.000 | **** | 1.701 | large |
| 4 | p1 | self | other | 0.001 | -0.008 | 0.009 | 19 | 0.166 | 0.870 | ns | 0.037 | negligible |
| 4 | p2 | self | other | 0.026 | 0.018 | 0.034 | 19 | 7.043 | 0.000 | **** | 1.575 | large |
| 5 | p1 | self | other | -0.005 | -0.015 | 0.005 | 19 | -1.069 | 0.299 | ns | -0.239 | small |
| 5 | p2 | self | other | 0.019 | 0.010 | 0.029 | 19 | 4.219 | 0.000 | *** | 0.943 | large |
| 6 | p1 | self | other | 0.001 | -0.008 | 0.009 | 19 | 0.147 | 0.884 | ns | 0.033 | negligible |
| 6 | p2 | self | other | 0.025 | 0.019 | 0.032 | 19 | 7.927 | 0.000 | **** | 1.773 | large |
| 7 | p1 | self | other | -0.012 | -0.042 | 0.019 | 19 | -0.796 | 0.436 | ns | -0.178 | negligible |
| 7 | p2 | self | other | 0.040 | 0.005 | 0.075 | 19 | 2.420 | 0.026 | * | 0.541 | moderate |
| 8 | p1 | self | other | 0.003 | -0.019 | 0.026 | 19 | 0.296 | 0.770 | ns | 0.066 | negligible |
| 8 | p2 | self | other | 0.007 | -0.015 | 0.029 | 19 | 0.697 | 0.494 | ns | 0.156 | negligible |
| 9 | p1 | self | other | 0.003 | -0.009 | 0.016 | 19 | 0.511 | 0.615 | ns | 0.114 | negligible |
| 9 | p2 | self | other | 0.007 | -0.003 | 0.016 | 19 | 1.490 | 0.153 | ns | 0.333 | small |
p_h1 <- r3_allL.1.tmp %>% group_by(netNum, type) %>%
rstatix::pairwise_t_test(r ~ part,
p.adjust.method="holm",
paired=T, detailed=T) %>%
dplyr::select(netNum, type, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r3_allL.1.tmp %>% group_by(netNum, type) %>%
rstatix::cohens_d(r ~ part, paired=T, ci = F) %>%
dplyr::select(netNum, type, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("netNum","type","group1", "group2")) %>% kable(digits=3)| netNum | type | group1 | group2 | estimate | conf.low | conf.high | df | statistic | p.adj | p.adj.signif | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 0 | other | p1 | p2 | -0.024 | -0.035 | -0.013 | 19 | -4.614 | 0.000 | *** | -1.032 | large |
| 0 | self | p1 | p2 | -0.033 | -0.052 | -0.014 | 19 | -3.636 | 0.002 | ** | -0.813 | large |
| 1 | other | p1 | p2 | -0.040 | -0.054 | -0.026 | 19 | -6.009 | 0.000 | **** | -1.344 | large |
| 1 | self | p1 | p2 | 0.010 | -0.019 | 0.040 | 19 | 0.729 | 0.475 | ns | 0.163 | negligible |
| 2 | other | p1 | p2 | -0.016 | -0.031 | -0.001 | 19 | -2.246 | 0.037 | * | -0.502 | moderate |
| 2 | self | p1 | p2 | -0.018 | -0.037 | 0.000 | 19 | -2.043 | 0.055 | ns | -0.457 | small |
| 3 | other | p1 | p2 | -0.018 | -0.032 | -0.004 | 19 | -2.760 | 0.013 | * | -0.617 | moderate |
| 3 | self | p1 | p2 | -0.027 | -0.045 | -0.010 | 19 | -3.316 | 0.004 | ** | -0.741 | moderate |
| 4 | other | p1 | p2 | -0.020 | -0.034 | -0.006 | 19 | -2.926 | 0.009 | ** | -0.654 | moderate |
| 4 | self | p1 | p2 | -0.046 | -0.065 | -0.027 | 19 | -5.093 | 0.000 | **** | -1.139 | large |
| 5 | other | p1 | p2 | -0.018 | -0.034 | -0.003 | 19 | -2.482 | 0.023 | * | -0.555 | moderate |
| 5 | self | p1 | p2 | -0.043 | -0.066 | -0.019 | 19 | -3.798 | 0.001 | ** | -0.849 | large |
| 6 | other | p1 | p2 | -0.033 | -0.048 | -0.017 | 19 | -4.443 | 0.000 | *** | -0.993 | large |
| 6 | self | p1 | p2 | -0.057 | -0.078 | -0.037 | 19 | -5.918 | 0.000 | **** | -1.323 | large |
| 7 | other | p1 | p2 | 0.000 | -0.060 | 0.060 | 19 | -0.002 | 0.998 | ns | 0.000 | negligible |
| 7 | self | p1 | p2 | -0.052 | -0.116 | 0.012 | 19 | -1.693 | 0.107 | ns | -0.379 | small |
| 8 | other | p1 | p2 | -0.001 | -0.028 | 0.027 | 19 | -0.065 | 0.949 | ns | -0.015 | negligible |
| 8 | self | p1 | p2 | -0.005 | -0.042 | 0.032 | 19 | -0.282 | 0.781 | ns | -0.063 | negligible |
| 9 | other | p1 | p2 | -0.041 | -0.063 | -0.020 | 19 | -4.077 | 0.001 | *** | -0.912 | large |
| 9 | self | p1 | p2 | -0.045 | -0.080 | -0.009 | 19 | -2.643 | 0.016 | * | -0.591 | moderate |
6.3.3 RSA - Difference : Within Part vs Between Part
보조적인 분석으로 Within-Between의 차이가 파트별로 유의하게 다른지를 살펴본다.
# subject-level, long format
r4_allL <- r1_3 %>% group_by(sn, netLabel, part) %>%
dplyr::summarise(r=mean(r_part)) %>%
ungroup()
## `summarise()` has grouped output by 'sn', 'netLabel'. You can override using the `.groups` argument.
# r4_allL %>% kable(digits=2)
# subject-level, wide format
r4_allW <- r4_allL %>% spread(key=part, value = r)
r4_allL.1 <- r4_allW %>% mutate(p1_self = p1_wn,
p2_self = p2_wn,
p1_other = (p1_2),
p2_other = (p2_1)) %>%
dplyr::select(sn, netLabel, p1_self, p2_self, p1_other, p2_other) %>%
gather(key = part, value = r, p1_self:p2_other, factor_key = T) %>%
separate(col = part, sep="_", into =c('part','type'))
r4_allL.1$part <- factor(r4_allL.1$part)
r4_allL.1$type <- factor(r4_allL.1$type, levels = c('self','other'))
r4_allL.2 <- r4_allL.1 %>% spread(key = type, value = r) %>% mutate(r = self - other) %>%
dplyr::select(sn, netLabel, part, r)
# r4_allL.1 %>% filter(sn == 2) %>% spread(key=part, value = r)
# r4_allL.1 %>% dplyr::filter(netLabel == "all_net") %>%
# spread(key = part, value = r) %>% kable(digits=2)
# summary table: grand mean
r4_allG <- r4_allL.2 %>% group_by(netLabel, part) %>%
dplyr::summarise(r.m = mean(r), r.sd = sd(r)) %>%
ungroup()
## `summarise()` has grouped output by 'netLabel'. You can override using the `.groups` argument.
r4_allG$r.se <- Rmisc::summarySEwithin(data = r4_allL.2, measurevar = "r",
idvar = "sn", withinvars = c("netLabel","part"))$se
r4_allG$r.ci <- Rmisc::summarySEwithin(data = r4_allL.2, measurevar = "r",
idvar = "sn", withinvars = c("netLabel","part"))$ci
r4_allG <- r4_allG %>%
mutate(lower.ci = r.m-r.ci,
upper.ci = r.m+r.ci,
lower.se = r.m-r.se,
upper.se = r.m+r.se)
r4_allG %>% dplyr::select(netLabel, part, r.m) %>%
spread(key=part, value=r.m) %>% kable(digits=2)| netLabel | p1 | p2 |
|---|---|---|
| All | 0.01 | 0.02 |
| Vis | 0.03 | -0.02 |
| SM | 0.01 | 0.01 |
| FPN | 0.02 | 0.02 |
| VAN | 0.00 | 0.03 |
| DAN | 0.00 | 0.02 |
| DMN | 0.00 | 0.03 |
| Limb | -0.01 | 0.04 |
| TP | 0.00 | 0.01 |
| SubCor | 0.00 | 0.01 |
# subject-level, long format
r4_allL <- r1_3 %>% group_by(sn, netNum, part) %>%
dplyr::summarise(r=mean(r_part)) %>%
ungroup()## `summarise()` has grouped output by 'sn', 'netNum'. You can override using the `.groups` argument.# r4_allL %>% kable(digits=2)
# subject-level, wide format
r4_allW <- r4_allL %>% spread(key=part, value = r)
r4_allL.1 <- r4_allW %>% mutate(p1_self = p1_wn,
p2_self = p2_wn,
p1_other = (p1_2),
p2_other = (p2_1)) %>%
dplyr::select(sn, netNum, p1_self, p2_self, p1_other, p2_other) %>%
gather(key = part, value = r, p1_self:p2_other, factor_key = T) %>%
separate(col = part, sep="_", into =c('part','type'))
r4_allL.1$part <- factor(r4_allL.1$part)
r4_allL.1$type <- factor(r4_allL.1$type, levels = c('self','other'))
r4_allL.2 <- r4_allL.1 %>% spread(key = type, value = r) %>% mutate(r = self - other) %>%
dplyr::select(sn, netNum, part, r)
r4_allW.2 <- r4_allL.2 %>% spread(key = part, value = r)
# summary table: grand mean
r4_allG <- r4_allL.2 %>% group_by(netNum, part) %>%
dplyr::summarise(r.m = mean(r), r.sd = sd(r)) %>%
ungroup()## `summarise()` has grouped output by 'netNum'. You can override using the `.groups` argument.r4_allG$r.se <- Rmisc::summarySEwithin(data = r4_allL.2, measurevar = "r",
idvar = "sn", withinvars = c("netNum","part"))$se
r4_allG$r.ci <- Rmisc::summarySEwithin(data = r4_allL.2, measurevar = "r",
idvar = "sn", withinvars = c("netNum","part"))$ci
r4_allG <- r4_allG %>%
mutate(lower.ci = r.m-r.ci,
upper.ci = r.m+r.ci,
lower.se = r.m-r.se,
upper.se = r.m+r.se)
# all_net
# 1. central visual
# 2. control A
# 3. control B
# 4. control C
# 5. default A
# 6. default B
# 7. default C
# 8. dorsal attention A
# 9. dorsal attention B
# 10. limbic A
# 11. limbic B
# 12. peripheral visual
# 13. salience / ventral attention A
# 14. salience / ventral attention B
# 15. somatomotor A
# 16. somatomotor B
# 17. temporal parietal
# 18. subCor
# plot 1
targNet = c(0)
r4_allL.p1 <- r4_allL.2 %>% filter(netNum %in% targNet)
r4_allW.p1 <- r4_allW.2 %>% filter(netNum %in% targNet)
r4_allG.p1 <- r4_allG %>% filter(netNum %in% targNet)
r4.p1.all.plot1 <- ggplot(data=r4_allL.p1, aes(x=part, y=r, fill=part, shpae=part)) +
stat_summary(fun = mean, geom = "bar", position="dodge",
na.rm = TRUE, alpha = .9, width = 0.8, color="black", size = 0.15) +
geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
facet_grid(.~netNum, scales="free_x", space = "free",
labeller = labeller(netNum = c("0" = "All",
"1" = "Vis",
"2" = "SM",
"3" = "Cont",
"4" = "sal/VAtt",
"5" = "DAN",
"6" = "DMN",
"7" = "Limb",
"8" = "TP",
"9" = "SubCor"))) +
geom_point(data=r4_allL.p1, aes(x=part, y=r, fill=part), position = position_dodge(width=0.8),
size=2, show.legend=F, color="gray90") +
geom_segment(data=filter(r4_allW.p1), inherit.aes = FALSE,
aes(x=1, y=filter(r4_allW.p1)$p1,
xend=2, yend=filter(r4_allW.p1)$p2),
color="gray90") +
geom_errorbar(data=r4_allG.p1, aes(x=part, y= r.m, ymin=r.m-r.ci, ymax=r.m+r.ci), width=.2,
position=position_dodge(.8), color = "black") +
scale_x_discrete(labels=c("Part 1","Part 2")) +
scale_fill_brewer(palette="Set2", # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
labels=c("Part 1","Part 2")) +
scale_color_brewer(palette="Set2", # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
labels=c("Part 1","Part 2")) +
# coord_cartesian(ylim = c(-1, 1), clip = "on") +
labs(x = "Part", y = "Difference btw Self & Other") +
ggtitle("FC - Yeo122net RSA") +
theme_bw(base_size = 18) +
theme(axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position="bottom")
# plot-control 3
# ggsave("fig1_1.fmri.jpg", plot = r4.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r4.p1.all.plot1
# all_net
# 1. central visual
# 2. control A
# 3. control B
# 4. control C
# 5. default A
# 6. default B
# 7. default C
# 8. dorsal attention A
# 9. dorsal attention B
# 10. limbic A
# 11. limbic B
# 12. peripheral visual
# 13. salience / ventral attention A
# 14. salience / ventral attention B
# 15. somatomotor A
# 16. somatomotor B
# 17. temporal parietal
# 18. subCor
# plot 2
targNet = c(1, 2, 3, 4, 5, 6, 7, 8, 9)
r4_allL.p1 <- r4_allL.2 %>% filter(netNum %in% targNet)
r4_allW.p1 <- r4_allW.2 %>% filter(netNum %in% targNet)
r4_allG.p1 <- r4_allG %>% filter(netNum %in% targNet)
r4.p1.all.plot2 <- ggplot(data=r4_allL.p1, aes(x=part, y=r, fill=part, shpae=part)) +
stat_summary(fun = mean, geom = "bar", position="dodge",
na.rm = TRUE, alpha = .9, width = 0.8, color="black", size = 0.15) +
geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
facet_grid(.~netNum, scales="free_x", space = "free",
labeller = labeller(netNum = c("0" = "All",
"1" = "Vis",
"2" = "SM",
"3" = "Cont",
"4" = "sal/VAtt",
"5" = "DAN",
"6" = "DMN",
"7" = "Limb",
"8" = "TP",
"9" = "SubCor"))) +
geom_point(data=r4_allL.p1, aes(x=part, y=r, fill=part), position = position_dodge(width=0.8),
size=2, show.legend=F, color="gray90") +
geom_segment(data=filter(r4_allW.p1), inherit.aes = FALSE,
aes(x=1, y=filter(r4_allW.p1)$p1,
xend=2, yend=filter(r4_allW.p1)$p2),
color="gray90") +
geom_errorbar(data=r4_allG.p1, aes(x=part, y= r.m, ymin=r.m-r.ci, ymax=r.m+r.ci), width=.2,
position=position_dodge(.8), color = "black") +
scale_x_discrete(labels=c("Part 1","Part 2")) +
scale_fill_brewer(palette="Set2", # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
labels=c("Part 1","Part 2")) +
scale_color_brewer(palette="Set2", # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
labels=c("Part 1","Part 2")) +
# coord_cartesian(ylim = c(-1, 1), clip = "on") +
labs(x = "Part", y = "Difference btw Self & Other") +
ggtitle("FC - Yeo122net RSA") +
theme_bw(base_size = 18) +
theme(#axis.text.x=element_blank(),
#axis.ticks.x=element_blank(),
axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position="bottom")
# plot-control 3
# ggsave("fig1_1.fmri.jpg", plot = r4.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r4.p1.all.plot2
RM-ANOVA
r4_allL.1.tmp <- r4_allL.2 # %>% filter(netNum == 0)
r4.aov1.tmp <- aov_ez(id="sn", dv="r", data = r4_allL.1.tmp, within = c("netNum", "part"))
# summary(r1.aov1)
nice(r4.aov1.tmp, es="pes") %>% kable(digits=2)| Effect | df | MSE | F | pes | p.value |
|---|---|---|---|---|---|
| netNum | 2.37, 45.10 | 0.00 | 1.79 | .086 | .173 |
| part | 1, 19 | 0.00 | 4.78 * | .201 | .042 |
| netNum:part | 2.68, 50.95 | 0.00 | 5.09 ** | .211 | .005 |
p_h1 <- r4_allL.1.tmp %>% group_by(netNum) %>%
rstatix::pairwise_t_test(r ~ part,
p.adjust.method="holm",
paired=T, detailed=T) %>%
dplyr::select(netNum, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r4_allL.1.tmp %>% group_by(netNum) %>%
rstatix::cohens_d(r ~ part, paired=T, ci = F) %>%
dplyr::select(netNum, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("netNum","group1", "group2")) %>% kable(digits=3)| netNum | group1 | group2 | estimate | conf.low | conf.high | df | statistic | p.adj | p.adj.signif | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 0 | p1 | p2 | -0.009 | -0.021 | 0.003 | 19 | -1.571 | 0.133 | ns | -0.351 | small |
| 1 | p1 | p2 | 0.050 | 0.027 | 0.073 | 19 | 4.603 | 0.000 | *** | 1.029 | large |
| 2 | p1 | p2 | -0.002 | -0.018 | 0.013 | 19 | -0.327 | 0.747 | ns | -0.073 | negligible |
| 3 | p1 | p2 | -0.009 | -0.024 | 0.005 | 19 | -1.325 | 0.201 | ns | -0.296 | small |
| 4 | p1 | p2 | -0.026 | -0.039 | -0.013 | 19 | -4.088 | 0.001 | *** | -0.914 | large |
| 5 | p1 | p2 | -0.024 | -0.042 | -0.007 | 19 | -2.939 | 0.008 | ** | -0.657 | moderate |
| 6 | p1 | p2 | -0.025 | -0.037 | -0.013 | 19 | -4.299 | 0.000 | *** | -0.961 | large |
| 7 | p1 | p2 | -0.052 | -0.108 | 0.004 | 19 | -1.937 | 0.068 | ns | -0.433 | small |
| 8 | p1 | p2 | -0.004 | -0.037 | 0.029 | 19 | -0.264 | 0.795 | ns | -0.059 | negligible |
| 9 | p1 | p2 | -0.004 | -0.023 | 0.016 | 19 | -0.377 | 0.710 | ns | -0.084 | negligible |
6.4 Univariate Analysis - FC value
각 네트워크 별로 Edge, 즉 Functional connectivity의 강도 자체가 구획별 차이를 보이는지 분석하였다. Edge의 부호(positive/negative)를 구분하여 살펴본다.
## FC
r10 <- read.csv("py_output/sFC_net_v2.csv", header = T)
r10_l <- r10 %>% dplyr::filter(sn %in% targ_sn)
r10_l$sn = factor(r10_l$sn)
r10_l$net = factor(r10_l$net,
levels = c('All', 'Vis', 'SM', 'FPN',
'VAN', 'DAN', 'DMN', 'Limb', 'SubCor','TP'),
labels = c('All', 'Vis', 'SM', 'FPN',
'VAN', 'DAN', 'DMN', 'Limb', 'SubCor','TP'))
r10_l$idx = factor(r10_l$idx)
r10_l$part = factor(r10_l$part,
levels = c(1,2),
labels = c('p1','p2'))
## Behavior
r10_behav <- read.csv("data/aniFCnet_behav.csv", header = T)
glimpse(r10_behav, width = 80)
## Rows: 630
## Columns: 7
## $ Idx <int> 26, 21, 12, 22, 7, 6, 4, 30, 29, 14, 5, 10, 28, 17, 19, 15…
## $ num <int> 26, 21, 12, 22, 7, 6, 4, 30, 29, 14, 5, 10, 28, 17, 19, 15…
## $ stimIdx <int> 2, 9, 10, 13, 15, 24, 25, 33, 44, 49, 58, 62, 68, 74, 81, …
## $ sn <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ correctness <int> 1, 1, 0, 0, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ scores <int> 9, 9, 1, 1, 7, 9, 9, 1, 1, 7, 8, 9, 6, 6, 8, 9, 9, 6, 9, 6…
## $ check <int> 0, 0, 1, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
r10_behav <- r10_behav %>% dplyr::filter(sn %in% targ_sn)
r10_behav$sn = factor(r10_behav$sn)
r10_behav$idx = factor(r10_behav$stimIdx)
r10_behav$corr = r10_behav$correctness
r10_behav <- r10_behav %>% dplyr::select(sn, idx, corr, scores, check)
r10_1 <- merge(r10_l, r10_behav, by = c("sn", "idx"))
r10_2 <- r10_1 %>% filter(corr == 1, check != 1)6.4.1 Positive Connectivity by Net & Part
Positive FC 값에 대한 분석을 수행한다.
# subject-level, long format
r10_allL <- r10_2 %>% group_by(sn, net, part) %>%
dplyr::summarise(r=mean(p_fc)) %>%
ungroup()
## `summarise()` has grouped output by 'sn', 'net'. You can override using the `.groups` argument.
# summary table: grand mean
r10_allG <- r10_allL %>% group_by(net, part) %>%
dplyr::summarise(r.m = mean(r), r.sd = sd(r)) %>%
ungroup()
## `summarise()` has grouped output by 'net'. You can override using the `.groups` argument.
r10_allG$r.se <- Rmisc::summarySEwithin(data = r10_allL, measurevar = "r",
idvar = "sn", withinvars = c("net","part"))$se
r10_allG$r.ci <- Rmisc::summarySEwithin(data = r10_allL, measurevar = "r",
idvar = "sn", withinvars = c("net","part"))$ci
r10_allG <- r10_allG %>%
mutate(lower.ci = r.m-r.ci,
upper.ci = r.m+r.ci,
lower.se = r.m-r.se,
upper.se = r.m+r.se)
r10_allG %>% dplyr::select(net, part, r.m) %>%
spread(key=part, value=r.m) %>% kable(digits=2)| net | p1 | p2 |
|---|---|---|
| All | 0.13 | 0.12 |
| Vis | 0.45 | 0.37 |
| SM | 0.46 | 0.44 |
| FPN | 0.21 | 0.18 |
| VAN | 0.26 | 0.24 |
| DAN | 0.30 | 0.29 |
| DMN | 0.23 | 0.22 |
| Limb | 0.51 | 0.50 |
| SubCor | 0.29 | 0.28 |
| TP | 0.63 | 0.59 |
r10_allL.p1 <- r10_allL
r10_allG.p1 <- r10_allG
r10.p1.all.plot1 <- ggplot(data=r10_allL.p1, aes(x=part, y=r, fill=part, shpae=part)) +
stat_summary(fun = mean, geom = "bar", position="dodge",
na.rm = TRUE, alpha = .9, width = 0.8, color="black", size = 0.15) +
facet_grid(.~net, scales="free_x", space = "free") +
geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
geom_point(data=r10_allL.p1, aes(x=part, y=r, fill=part), position = position_dodge(width=0.8),
size=2, show.legend=F, color="gray90") +
geom_errorbar(data=r10_allG.p1, aes(x=part, y= r.m, ymin=r.m-r.ci, ymax=r.m+r.ci), width=.2,
position=position_dodge(.8), color = "black") +
# scale_x_discrete(labels=c("Within", "Between")) +
scale_fill_manual(values = c("#ED7D31", "#5B9BD5"), # c("#ED7D31", "#5B9BD5", "#70AD47"),
labels = c("First Half", "Second Half")) + scale_color_brewer(palette="Set2") +
# coord_cartesian(ylim = c(-0.4, 0.4), clip = "on") +
labs(x = "Part", y = "Functional Connectivity (FC)") +
ggtitle("mean FC") +
theme_bw(base_size = 18) +
theme(#axis.text.x=element_blank(),
#axis.ticks.x=element_blank(),
axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position="bottom")
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r10.p1.all.plot1
통계 분석 결과는 아래와 같다.
r10_allL.1.tmp <- r10_allL
r10.aov1.tmp <- aov_ez(id="sn", dv="r", data = r10_allL.1.tmp, within = c("net","part"))
# summary(r10.aov1)
nice(r10.aov1.tmp, es="pes") %>% kable(digits=2)| Effect | df | MSE | F | pes | p.value |
|---|---|---|---|---|---|
| net | 3.17, 60.15 | 0.02 | 154.54 *** | .891 | <.001 |
| part | 1, 19 | 0.00 | 114.48 *** | .858 | <.001 |
| net:part | 2.95, 56.01 | 0.00 | 8.51 *** | .309 | <.001 |
p_h1 <- r10_allL.1.tmp %>% group_by(net) %>%
rstatix::pairwise_t_test(r ~ part,
p.adjust.method="holm",
paired=T, detailed=T) %>%
dplyr::select(net, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r10_allL.1.tmp %>% group_by(net) %>%
rstatix::cohens_d(r ~ part, paired=T, ci = F) %>%
dplyr::select(net, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("net", "group1", "group2")) %>% kable(digits=3)| net | group1 | group2 | estimate | conf.low | conf.high | df | statistic | p.adj | p.adj.signif | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|
| All | p1 | p2 | 0.012 | 0.010 | 0.013 | 19 | 15.712 | 0.000 | **** | 3.513 | large |
| DAN | p1 | p2 | 0.004 | -0.005 | 0.013 | 19 | 1.032 | 0.315 | ns | 0.231 | small |
| DMN | p1 | p2 | 0.015 | 0.009 | 0.021 | 19 | 5.212 | 0.000 | **** | 1.165 | large |
| FPN | p1 | p2 | 0.029 | 0.023 | 0.036 | 19 | 9.744 | 0.000 | **** | 2.179 | large |
| Limb | p1 | p2 | 0.003 | -0.014 | 0.021 | 19 | 0.426 | 0.675 | ns | 0.095 | negligible |
| SM | p1 | p2 | 0.014 | -0.008 | 0.035 | 19 | 1.328 | 0.200 | ns | 0.297 | small |
| SubCor | p1 | p2 | 0.005 | -0.006 | 0.016 | 19 | 0.906 | 0.376 | ns | 0.203 | small |
| TP | p1 | p2 | 0.036 | 0.003 | 0.069 | 19 | 2.315 | 0.032 | * | 0.518 | moderate |
| VAN | p1 | p2 | 0.025 | 0.016 | 0.034 | 19 | 5.820 | 0.000 | **** | 1.301 | large |
| Vis | p1 | p2 | 0.075 | 0.062 | 0.087 | 19 | 12.318 | 0.000 | **** | 2.754 | large |
p_h1 <- r10_allL.1.tmp %>% group_by(part) %>%
rstatix::pairwise_t_test(r ~ net,
p.adjust.method="holm",
paired=T, detailed=T) %>%
dplyr::select(part, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r10_allL.1.tmp %>% group_by(part) %>%
rstatix::cohens_d(r ~ net, paired=T, ci = F) %>%
dplyr::select(part, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("part", "group1", "group2")) %>% kable(digits=3)| part | group1 | group2 | estimate | conf.low | conf.high | df | statistic | p.adj | p.adj.signif | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|
| p1 | All | DAN | -0.166 | -0.190 | -0.142 | 19 | -14.705 | 0.000 | **** | -3.288 | large |
| p1 | All | DMN | -0.101 | -0.109 | -0.093 | 19 | -26.346 | 0.000 | **** | -5.891 | large |
| p1 | All | FPN | -0.081 | -0.092 | -0.070 | 19 | -14.825 | 0.000 | **** | -3.315 | large |
| p1 | All | Limb | -0.375 | -0.411 | -0.339 | 19 | -21.765 | 0.000 | **** | -4.867 | large |
| p1 | All | SM | -0.327 | -0.362 | -0.292 | 19 | -19.612 | 0.000 | **** | -4.385 | large |
| p1 | All | SubCor | -0.159 | -0.176 | -0.141 | 19 | -19.138 | 0.000 | **** | -4.279 | large |
| p1 | All | TP | -0.499 | -0.568 | -0.430 | 19 | -15.136 | 0.000 | **** | -3.385 | large |
| p1 | All | VAN | -0.134 | -0.149 | -0.119 | 19 | -19.087 | 0.000 | **** | -4.268 | large |
| p1 | All | Vis | -0.318 | -0.342 | -0.294 | 19 | -27.552 | 0.000 | **** | -6.161 | large |
| p1 | DAN | DMN | 0.065 | 0.040 | 0.090 | 19 | 5.426 | 0.000 | *** | 1.213 | large |
| p1 | DAN | Limb | -0.209 | -0.252 | -0.165 | 19 | -10.108 | 0.000 | **** | -2.260 | large |
| p1 | DAN | SubCor | 0.007 | -0.024 | 0.039 | 19 | 0.499 | 1.000 | ns | 0.112 | negligible |
| p1 | DAN | TP | -0.333 | -0.395 | -0.272 | 19 | -11.329 | 0.000 | **** | -2.533 | large |
| p1 | DMN | Limb | -0.274 | -0.313 | -0.235 | 19 | -14.811 | 0.000 | **** | -3.312 | large |
| p1 | DMN | SubCor | -0.058 | -0.075 | -0.041 | 19 | -7.098 | 0.000 | **** | -1.587 | large |
| p1 | DMN | TP | -0.399 | -0.469 | -0.328 | 19 | -11.823 | 0.000 | **** | -2.644 | large |
| p1 | FPN | DAN | -0.085 | -0.107 | -0.064 | 19 | -8.290 | 0.000 | **** | -1.854 | large |
| p1 | FPN | DMN | -0.020 | -0.033 | -0.007 | 19 | -3.136 | 0.038 | * | -0.701 | moderate |
| p1 | FPN | Limb | -0.294 | -0.334 | -0.253 | 19 | -15.284 | 0.000 | **** | -3.418 | large |
| p1 | FPN | SubCor | -0.078 | -0.099 | -0.056 | 19 | -7.525 | 0.000 | **** | -1.683 | large |
| p1 | FPN | TP | -0.418 | -0.481 | -0.355 | 19 | -13.870 | 0.000 | **** | -3.102 | large |
| p1 | FPN | VAN | -0.053 | -0.067 | -0.039 | 19 | -7.735 | 0.000 | **** | -1.730 | large |
| p1 | Limb | SubCor | 0.216 | 0.184 | 0.248 | 19 | 13.982 | 0.000 | **** | 3.127 | large |
| p1 | Limb | TP | -0.125 | -0.196 | -0.054 | 19 | -3.683 | 0.013 | * | -0.823 | large |
| p1 | SM | DAN | 0.161 | 0.120 | 0.202 | 19 | 8.278 | 0.000 | **** | 1.851 | large |
| p1 | SM | DMN | 0.226 | 0.192 | 0.261 | 19 | 13.798 | 0.000 | **** | 3.085 | large |
| p1 | SM | FPN | 0.246 | 0.213 | 0.279 | 19 | 15.632 | 0.000 | **** | 3.496 | large |
| p1 | SM | Limb | -0.048 | -0.095 | 0.000 | 19 | -2.103 | 0.196 | ns | -0.470 | small |
| p1 | SM | SubCor | 0.168 | 0.135 | 0.202 | 19 | 10.467 | 0.000 | **** | 2.340 | large |
| p1 | SM | TP | -0.172 | -0.240 | -0.105 | 19 | -5.350 | 0.000 | *** | -1.196 | large |
| p1 | SM | VAN | 0.193 | 0.156 | 0.230 | 19 | 10.858 | 0.000 | **** | 2.428 | large |
| p1 | SubCor | TP | -0.341 | -0.411 | -0.271 | 19 | -10.170 | 0.000 | **** | -2.274 | large |
| p1 | VAN | DAN | -0.032 | -0.057 | -0.008 | 19 | -2.752 | 0.076 | ns | -0.615 | moderate |
| p1 | VAN | DMN | 0.033 | 0.018 | 0.048 | 19 | 4.565 | 0.002 | ** | 1.021 | large |
| p1 | VAN | Limb | -0.241 | -0.281 | -0.200 | 19 | -12.486 | 0.000 | **** | -2.792 | large |
| p1 | VAN | SubCor | -0.025 | -0.050 | 0.001 | 19 | -2.019 | 0.196 | ns | -0.451 | small |
| p1 | VAN | TP | -0.365 | -0.430 | -0.301 | 19 | -11.794 | 0.000 | **** | -2.637 | large |
| p1 | Vis | DAN | 0.152 | 0.125 | 0.178 | 19 | 11.962 | 0.000 | **** | 2.675 | large |
| p1 | Vis | DMN | 0.217 | 0.192 | 0.242 | 19 | 17.932 | 0.000 | **** | 4.010 | large |
| p1 | Vis | FPN | 0.237 | 0.214 | 0.260 | 19 | 21.685 | 0.000 | **** | 4.849 | large |
| p1 | Vis | Limb | -0.057 | -0.103 | -0.011 | 19 | -2.569 | 0.094 | ns | -0.574 | moderate |
| p1 | Vis | SM | -0.009 | -0.054 | 0.036 | 19 | -0.435 | 1.000 | ns | -0.097 | negligible |
| p1 | Vis | SubCor | 0.159 | 0.125 | 0.193 | 19 | 9.774 | 0.000 | **** | 2.185 | large |
| p1 | Vis | TP | -0.182 | -0.247 | -0.116 | 19 | -5.821 | 0.000 | *** | -1.302 | large |
| p1 | Vis | VAN | 0.184 | 0.160 | 0.207 | 19 | 16.268 | 0.000 | **** | 3.638 | large |
| p2 | All | DAN | -0.174 | -0.196 | -0.151 | 19 | -16.363 | 0.000 | **** | -3.659 | large |
| p2 | All | DMN | -0.098 | -0.105 | -0.091 | 19 | -28.463 | 0.000 | **** | -6.364 | large |
| p2 | All | FPN | -0.064 | -0.073 | -0.054 | 19 | -14.323 | 0.000 | **** | -3.203 | large |
| p2 | All | Limb | -0.383 | -0.419 | -0.348 | 19 | -22.588 | 0.000 | **** | -5.051 | large |
| p2 | All | SM | -0.325 | -0.360 | -0.290 | 19 | -19.402 | 0.000 | **** | -4.338 | large |
| p2 | All | SubCor | -0.166 | -0.184 | -0.147 | 19 | -18.796 | 0.000 | **** | -4.203 | large |
| p2 | All | TP | -0.475 | -0.530 | -0.420 | 19 | -18.164 | 0.000 | **** | -4.062 | large |
| p2 | All | VAN | -0.121 | -0.136 | -0.105 | 19 | -16.591 | 0.000 | **** | -3.710 | large |
| p2 | All | Vis | -0.255 | -0.276 | -0.234 | 19 | -25.448 | 0.000 | **** | -5.690 | large |
| p2 | DAN | DMN | 0.076 | 0.054 | 0.097 | 19 | 7.235 | 0.000 | **** | 1.618 | large |
| p2 | DAN | Limb | -0.210 | -0.249 | -0.170 | 19 | -11.190 | 0.000 | **** | -2.502 | large |
| p2 | DAN | SubCor | 0.008 | -0.023 | 0.038 | 19 | 0.535 | 0.599 | ns | 0.120 | negligible |
| p2 | DAN | TP | -0.301 | -0.353 | -0.250 | 19 | -12.243 | 0.000 | **** | -2.738 | large |
| p2 | DMN | Limb | -0.285 | -0.322 | -0.248 | 19 | -16.269 | 0.000 | **** | -3.638 | large |
| p2 | DMN | SubCor | -0.068 | -0.087 | -0.049 | 19 | -7.536 | 0.000 | **** | -1.685 | large |
| p2 | DMN | TP | -0.377 | -0.432 | -0.322 | 19 | -14.296 | 0.000 | **** | -3.197 | large |
| p2 | FPN | DAN | -0.110 | -0.129 | -0.091 | 19 | -12.079 | 0.000 | **** | -2.701 | large |
| p2 | FPN | DMN | -0.034 | -0.044 | -0.025 | 19 | -7.660 | 0.000 | **** | -1.713 | large |
| p2 | FPN | Limb | -0.319 | -0.358 | -0.281 | 19 | -17.304 | 0.000 | **** | -3.869 | large |
| p2 | FPN | SubCor | -0.102 | -0.125 | -0.079 | 19 | -9.374 | 0.000 | **** | -2.096 | large |
| p2 | FPN | TP | -0.411 | -0.462 | -0.361 | 19 | -16.986 | 0.000 | **** | -3.798 | large |
| p2 | FPN | VAN | -0.057 | -0.071 | -0.043 | 19 | -8.477 | 0.000 | **** | -1.896 | large |
| p2 | Limb | SubCor | 0.217 | 0.184 | 0.250 | 19 | 13.748 | 0.000 | **** | 3.074 | large |
| p2 | Limb | TP | -0.092 | -0.158 | -0.026 | 19 | -2.908 | 0.027 | * | -0.650 | moderate |
| p2 | SM | DAN | 0.152 | 0.112 | 0.191 | 19 | 8.068 | 0.000 | **** | 1.804 | large |
| p2 | SM | DMN | 0.227 | 0.194 | 0.260 | 19 | 14.489 | 0.000 | **** | 3.240 | large |
| p2 | SM | FPN | 0.262 | 0.228 | 0.296 | 19 | 16.156 | 0.000 | **** | 3.613 | large |
| p2 | SM | Limb | -0.058 | -0.102 | -0.013 | 19 | -2.719 | 0.027 | * | -0.608 | moderate |
| p2 | SM | SubCor | 0.160 | 0.125 | 0.195 | 19 | 9.550 | 0.000 | **** | 2.136 | large |
| p2 | SM | TP | -0.150 | -0.199 | -0.100 | 19 | -6.299 | 0.000 | **** | -1.408 | large |
| p2 | SM | VAN | 0.205 | 0.168 | 0.241 | 19 | 11.757 | 0.000 | **** | 2.629 | large |
| p2 | SubCor | TP | -0.309 | -0.366 | -0.253 | 19 | -11.437 | 0.000 | **** | -2.557 | large |
| p2 | VAN | DAN | -0.053 | -0.075 | -0.031 | 19 | -5.145 | 0.000 | *** | -1.150 | large |
| p2 | VAN | DMN | 0.023 | 0.007 | 0.038 | 19 | 3.134 | 0.022 | * | 0.701 | moderate |
| p2 | VAN | Limb | -0.262 | -0.300 | -0.225 | 19 | -14.627 | 0.000 | **** | -3.271 | large |
| p2 | VAN | SubCor | -0.045 | -0.070 | -0.020 | 19 | -3.783 | 0.008 | ** | -0.846 | large |
| p2 | VAN | TP | -0.354 | -0.406 | -0.303 | 19 | -14.421 | 0.000 | **** | -3.225 | large |
| p2 | Vis | DAN | 0.081 | 0.055 | 0.108 | 19 | 6.461 | 0.000 | **** | 1.445 | large |
| p2 | Vis | DMN | 0.157 | 0.134 | 0.180 | 19 | 14.387 | 0.000 | **** | 3.217 | large |
| p2 | Vis | FPN | 0.191 | 0.173 | 0.210 | 19 | 21.693 | 0.000 | **** | 4.851 | large |
| p2 | Vis | Limb | -0.128 | -0.172 | -0.084 | 19 | -6.120 | 0.000 | **** | -1.368 | large |
| p2 | Vis | SM | -0.070 | -0.110 | -0.031 | 19 | -3.751 | 0.008 | ** | -0.839 | large |
| p2 | Vis | SubCor | 0.089 | 0.062 | 0.117 | 19 | 6.790 | 0.000 | **** | 1.518 | large |
| p2 | Vis | TP | -0.220 | -0.274 | -0.166 | 19 | -8.546 | 0.000 | **** | -1.911 | large |
| p2 | Vis | VAN | 0.134 | 0.113 | 0.155 | 19 | 13.425 | 0.000 | **** | 3.002 | large |
6.4.2 Negative Connectivity by Net & Part
Negative FC에 대한 분석을 수행한다.
# subject-level, long format
r10_allL <- r10_2 %>% group_by(sn, net, part) %>%
dplyr::summarise(r=mean(n_fc)) %>%
ungroup()
## `summarise()` has grouped output by 'sn', 'net'. You can override using the `.groups` argument.
# summary table: grand mean
r10_allG <- r10_allL %>% group_by(net, part) %>%
dplyr::summarise(r.m = mean(r), r.sd = sd(r)) %>%
ungroup()
## `summarise()` has grouped output by 'net'. You can override using the `.groups` argument.
r10_allG$r.se <- Rmisc::summarySEwithin(data = r10_allL, measurevar = "r",
idvar = "sn", withinvars = c("net","part"))$se
r10_allG$r.ci <- Rmisc::summarySEwithin(data = r10_allL, measurevar = "r",
idvar = "sn", withinvars = c("net","part"))$ci
r10_allG <- r10_allG %>%
mutate(lower.ci = r.m-r.ci,
upper.ci = r.m+r.ci,
lower.se = r.m-r.se,
upper.se = r.m+r.se)
r10_allG %>% dplyr::select(net, part, r.m) %>%
spread(key=part, value=r.m) %>% kable(digits=2)| net | p1 | p2 |
|---|---|---|
| All | -0.11 | -0.10 |
| Vis | -0.04 | -0.04 |
| SM | -0.01 | -0.01 |
| FPN | -0.06 | -0.06 |
| VAN | -0.03 | -0.03 |
| DAN | -0.04 | -0.04 |
| DMN | -0.05 | -0.05 |
| Limb | -0.01 | -0.01 |
| SubCor | -0.04 | -0.03 |
| TP | 0.00 | 0.00 |
r10_allL.p1 <- r10_allL
r10_allG.p1 <- r10_allG
r10.p1.all.plot1 <- ggplot(data=r10_allL.p1, aes(x=part, y=r, fill=part, shpae=part)) +
stat_summary(fun = mean, geom = "bar", position="dodge",
na.rm = TRUE, alpha = .9, width = 0.8, color="black", size = 0.15) +
facet_grid(.~net, scales="free_x", space = "free") +
geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
geom_point(data=r10_allL.p1, aes(x=part, y=r, fill=part), position = position_dodge(width=0.8),
size=2, show.legend=F, color="gray90") +
geom_errorbar(data=r10_allG.p1, aes(x=part, y= r.m, ymin=r.m-r.ci, ymax=r.m+r.ci), width=.2,
position=position_dodge(.8), color = "black") +
# scale_x_discrete(labels=c("Within", "Between")) +
scale_fill_manual(values = c("#ED7D31", "#5B9BD5"), # c("#ED7D31", "#5B9BD5", "#70AD47"),
labels = c("First Half", "Second Half")) + scale_color_brewer(palette="Set2") +
# coord_cartesian(ylim = c(-0.4, 0.4), clip = "on") +
labs(x = "Part", y = "Functional Connectivity (FC)") +
ggtitle("mean FC") +
theme_bw(base_size = 18) +
theme(#axis.text.x=element_blank(),
#axis.ticks.x=element_blank(),
axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position="bottom")
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r10.p1.all.plot1
통계 분석 결과는 아래와 같다.
r10_allL.1.tmp <- r10_allL
r10.aov1.tmp <- aov_ez(id="sn", dv="r", data = r10_allL.1.tmp, within = c("net","part"))
# summary(r10.aov1)
nice(r10.aov1.tmp, es="pes") %>% kable(digits=2)| Effect | df | MSE | F | pes | p.value |
|---|---|---|---|---|---|
| net | 4.06, 77.07 | 0.00 | 118.41 *** | .862 | <.001 |
| part | 1, 19 | 0.00 | 50.72 *** | .727 | <.001 |
| net:part | 4.86, 92.35 | 0.00 | 4.72 *** | .199 | <.001 |
p_h1 <- r10_allL.1.tmp %>% group_by(net) %>%
rstatix::pairwise_t_test(r ~ part,
p.adjust.method="holm",
paired=T, detailed=T) %>%
dplyr::select(net, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r10_allL.1.tmp %>% group_by(net) %>%
rstatix::cohens_d(r ~ part, paired=T, ci = F) %>%
dplyr::select(net, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("net", "group1", "group2")) %>% kable(digits=3)| net | group1 | group2 | estimate | conf.low | conf.high | df | statistic | p.adj | p.adj.signif | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|
| All | p1 | p2 | -0.009 | -0.011 | -0.007 | 19 | -10.934 | 0.000 | **** | -2.445 | large |
| DAN | p1 | p2 | -0.005 | -0.009 | -0.002 | 19 | -3.171 | 0.005 | ** | -0.709 | moderate |
| DMN | p1 | p2 | -0.003 | -0.006 | -0.001 | 19 | -2.604 | 0.018 | * | -0.582 | moderate |
| FPN | p1 | p2 | -0.003 | -0.006 | 0.001 | 19 | -1.698 | 0.106 | ns | -0.380 | small |
| Limb | p1 | p2 | -0.005 | -0.008 | -0.001 | 19 | -2.843 | 0.010 | * | -0.636 | moderate |
| SM | p1 | p2 | -0.001 | -0.003 | 0.001 | 19 | -1.322 | 0.202 | ns | -0.296 | small |
| SubCor | p1 | p2 | -0.011 | -0.015 | -0.006 | 19 | -4.991 | 0.000 | **** | -1.116 | large |
| TP | p1 | p2 | -0.001 | -0.003 | 0.001 | 19 | -0.877 | 0.392 | ns | -0.196 | negligible |
| VAN | p1 | p2 | -0.001 | -0.004 | 0.001 | 19 | -1.031 | 0.316 | ns | -0.231 | small |
| Vis | p1 | p2 | 0.000 | -0.006 | 0.006 | 19 | -0.005 | 0.996 | ns | -0.001 | negligible |
p_h1 <- r10_allL.1.tmp %>% group_by(part) %>%
rstatix::pairwise_t_test(r ~ net,
p.adjust.method="holm",
paired=T, detailed=T) %>%
dplyr::select(part, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r10_allL.1.tmp %>% group_by(part) %>%
rstatix::cohens_d(r ~ net, paired=T, ci = F) %>%
dplyr::select(part, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("part", "group1", "group2")) %>% kable(digits=3)| part | group1 | group2 | estimate | conf.low | conf.high | df | statistic | p.adj | p.adj.signif | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|
| p1 | All | DAN | -0.068 | -0.077 | -0.059 | 19 | -15.332 | 0.000 | **** | -3.428 | large |
| p1 | All | DMN | -0.056 | -0.062 | -0.051 | 19 | -21.039 | 0.000 | **** | -4.704 | large |
| p1 | All | FPN | -0.045 | -0.052 | -0.038 | 19 | -14.339 | 0.000 | **** | -3.206 | large |
| p1 | All | Limb | -0.097 | -0.105 | -0.089 | 19 | -24.311 | 0.000 | **** | -5.436 | large |
| p1 | All | SM | -0.100 | -0.105 | -0.096 | 19 | -50.924 | 0.000 | **** | -11.387 | large |
| p1 | All | SubCor | -0.067 | -0.078 | -0.056 | 19 | -12.750 | 0.000 | **** | -2.851 | large |
| p1 | All | TP | -0.108 | -0.111 | -0.105 | 19 | -68.011 | 0.000 | **** | -15.208 | large |
| p1 | All | VAN | -0.075 | -0.079 | -0.071 | 19 | -40.635 | 0.000 | **** | -9.086 | large |
| p1 | All | Vis | -0.074 | -0.084 | -0.064 | 19 | -16.005 | 0.000 | **** | -3.579 | large |
| p1 | DAN | DMN | 0.012 | 0.004 | 0.020 | 19 | 2.968 | 0.079 | ns | 0.664 | moderate |
| p1 | DAN | Limb | -0.029 | -0.040 | -0.018 | 19 | -5.386 | 0.001 | *** | -1.204 | large |
| p1 | DAN | SubCor | 0.001 | -0.014 | 0.016 | 19 | 0.141 | 1.000 | ns | 0.032 | negligible |
| p1 | DAN | TP | -0.040 | -0.048 | -0.033 | 19 | -11.015 | 0.000 | **** | -2.463 | large |
| p1 | DMN | Limb | -0.041 | -0.052 | -0.030 | 19 | -7.913 | 0.000 | **** | -1.769 | large |
| p1 | DMN | SubCor | -0.011 | -0.022 | 0.001 | 19 | -1.964 | 0.515 | ns | -0.439 | small |
| p1 | DMN | TP | -0.052 | -0.056 | -0.048 | 19 | -27.800 | 0.000 | **** | -6.216 | large |
| p1 | FPN | DAN | -0.023 | -0.033 | -0.013 | 19 | -4.752 | 0.002 | ** | -1.063 | large |
| p1 | FPN | DMN | -0.011 | -0.018 | -0.004 | 19 | -3.394 | 0.040 | * | -0.759 | moderate |
| p1 | FPN | Limb | -0.052 | -0.062 | -0.042 | 19 | -10.394 | 0.000 | **** | -2.324 | large |
| p1 | FPN | SubCor | -0.022 | -0.036 | -0.008 | 19 | -3.319 | 0.043 | * | -0.742 | moderate |
| p1 | FPN | TP | -0.063 | -0.069 | -0.057 | 19 | -20.993 | 0.000 | **** | -4.694 | large |
| p1 | FPN | VAN | -0.030 | -0.038 | -0.023 | 19 | -8.261 | 0.000 | **** | -1.847 | large |
| p1 | Limb | SubCor | 0.030 | 0.015 | 0.045 | 19 | 4.299 | 0.006 | ** | 0.961 | large |
| p1 | Limb | TP | -0.011 | -0.020 | -0.002 | 19 | -2.631 | 0.149 | ns | -0.588 | moderate |
| p1 | SM | DAN | 0.032 | 0.025 | 0.040 | 19 | 9.045 | 0.000 | **** | 2.023 | large |
| p1 | SM | DMN | 0.044 | 0.040 | 0.048 | 19 | 23.911 | 0.000 | **** | 5.347 | large |
| p1 | SM | FPN | 0.055 | 0.049 | 0.061 | 19 | 19.411 | 0.000 | **** | 4.340 | large |
| p1 | SM | Limb | 0.003 | -0.006 | 0.013 | 19 | 0.770 | 1.000 | ns | 0.172 | negligible |
| p1 | SM | SubCor | 0.033 | 0.022 | 0.044 | 19 | 6.358 | 0.000 | **** | 1.422 | large |
| p1 | SM | TP | -0.008 | -0.010 | -0.005 | 19 | -6.521 | 0.000 | **** | -1.458 | large |
| p1 | SM | VAN | 0.025 | 0.021 | 0.029 | 19 | 12.769 | 0.000 | **** | 2.855 | large |
| p1 | SubCor | TP | -0.041 | -0.053 | -0.030 | 19 | -7.430 | 0.000 | **** | -1.661 | large |
| p1 | VAN | DAN | 0.007 | -0.001 | 0.015 | 19 | 1.914 | 0.515 | ns | 0.428 | small |
| p1 | VAN | DMN | 0.019 | 0.014 | 0.025 | 19 | 7.429 | 0.000 | **** | 1.661 | large |
| p1 | VAN | Limb | -0.022 | -0.030 | -0.013 | 19 | -5.398 | 0.001 | *** | -1.207 | large |
| p1 | VAN | SubCor | 0.008 | -0.004 | 0.021 | 19 | 1.392 | 1.000 | ns | 0.311 | small |
| p1 | VAN | TP | -0.033 | -0.037 | -0.029 | 19 | -17.664 | 0.000 | **** | -3.950 | large |
| p1 | Vis | DAN | 0.006 | -0.004 | 0.016 | 19 | 1.271 | 1.000 | ns | 0.284 | small |
| p1 | Vis | DMN | 0.018 | 0.008 | 0.028 | 19 | 3.630 | 0.025 | * | 0.812 | large |
| p1 | Vis | FPN | 0.029 | 0.017 | 0.041 | 19 | 4.894 | 0.002 | ** | 1.094 | large |
| p1 | Vis | Limb | -0.023 | -0.037 | -0.008 | 19 | -3.316 | 0.043 | * | -0.741 | moderate |
| p1 | Vis | SM | -0.026 | -0.036 | -0.016 | 19 | -5.535 | 0.000 | *** | -1.238 | large |
| p1 | Vis | SubCor | 0.007 | -0.008 | 0.022 | 19 | 1.000 | 1.000 | ns | 0.224 | small |
| p1 | Vis | TP | -0.034 | -0.043 | -0.025 | 19 | -7.688 | 0.000 | **** | -1.719 | large |
| p1 | Vis | VAN | -0.001 | -0.010 | 0.008 | 19 | -0.288 | 1.000 | ns | -0.064 | negligible |
| p2 | All | DAN | -0.064 | -0.073 | -0.055 | 19 | -15.347 | 0.000 | **** | -3.432 | large |
| p2 | All | DMN | -0.050 | -0.055 | -0.045 | 19 | -20.437 | 0.000 | **** | -4.570 | large |
| p2 | All | FPN | -0.039 | -0.044 | -0.033 | 19 | -14.935 | 0.000 | **** | -3.339 | large |
| p2 | All | Limb | -0.092 | -0.098 | -0.087 | 19 | -32.589 | 0.000 | **** | -7.287 | large |
| p2 | All | SM | -0.093 | -0.097 | -0.088 | 19 | -47.764 | 0.000 | **** | -10.680 | large |
| p2 | All | SubCor | -0.068 | -0.079 | -0.058 | 19 | -13.802 | 0.000 | **** | -3.086 | large |
| p2 | All | TP | -0.100 | -0.102 | -0.098 | 19 | -88.832 | 0.000 | **** | -19.863 | large |
| p2 | All | VAN | -0.067 | -0.072 | -0.063 | 19 | -30.315 | 0.000 | **** | -6.779 | large |
| p2 | All | Vis | -0.065 | -0.071 | -0.059 | 19 | -21.317 | 0.000 | **** | -4.767 | large |
| p2 | DAN | DMN | 0.014 | 0.005 | 0.022 | 19 | 3.366 | 0.029 | * | 0.753 | moderate |
| p2 | DAN | Limb | -0.028 | -0.038 | -0.019 | 19 | -6.314 | 0.000 | **** | -1.412 | large |
| p2 | DAN | SubCor | -0.004 | -0.018 | 0.009 | 19 | -0.669 | 1.000 | ns | -0.150 | negligible |
| p2 | DAN | TP | -0.036 | -0.044 | -0.028 | 19 | -9.224 | 0.000 | **** | -2.063 | large |
| p2 | DMN | Limb | -0.042 | -0.050 | -0.034 | 19 | -11.358 | 0.000 | **** | -2.540 | large |
| p2 | DMN | SubCor | -0.018 | -0.029 | -0.007 | 19 | -3.470 | 0.026 | * | -0.776 | moderate |
| p2 | DMN | TP | -0.050 | -0.055 | -0.045 | 19 | -21.520 | 0.000 | **** | -4.812 | large |
| p2 | FPN | DAN | -0.025 | -0.034 | -0.017 | 19 | -6.195 | 0.000 | *** | -1.385 | large |
| p2 | FPN | DMN | -0.012 | -0.017 | -0.006 | 19 | -4.575 | 0.003 | ** | -1.023 | large |
| p2 | FPN | Limb | -0.054 | -0.061 | -0.046 | 19 | -14.857 | 0.000 | **** | -3.322 | large |
| p2 | FPN | SubCor | -0.030 | -0.042 | -0.017 | 19 | -5.004 | 0.001 | ** | -1.119 | large |
| p2 | FPN | TP | -0.061 | -0.066 | -0.056 | 19 | -25.822 | 0.000 | **** | -5.774 | large |
| p2 | FPN | VAN | -0.029 | -0.034 | -0.023 | 19 | -10.448 | 0.000 | **** | -2.336 | large |
| p2 | Limb | SubCor | 0.024 | 0.011 | 0.037 | 19 | 3.888 | 0.012 | * | 0.869 | large |
| p2 | Limb | TP | -0.007 | -0.014 | -0.001 | 19 | -2.319 | 0.254 | ns | -0.518 | moderate |
| p2 | SM | DAN | 0.029 | 0.021 | 0.036 | 19 | 7.585 | 0.000 | **** | 1.696 | large |
| p2 | SM | DMN | 0.042 | 0.039 | 0.046 | 19 | 24.004 | 0.000 | **** | 5.367 | large |
| p2 | SM | FPN | 0.054 | 0.049 | 0.058 | 19 | 25.223 | 0.000 | **** | 5.640 | large |
| p2 | SM | Limb | 0.000 | -0.008 | 0.008 | 19 | 0.021 | 1.000 | ns | 0.005 | negligible |
| p2 | SM | SubCor | 0.024 | 0.014 | 0.035 | 19 | 4.864 | 0.002 | ** | 1.088 | large |
| p2 | SM | TP | -0.007 | -0.010 | -0.005 | 19 | -5.665 | 0.000 | *** | -1.267 | large |
| p2 | SM | VAN | 0.025 | 0.021 | 0.029 | 19 | 13.167 | 0.000 | **** | 2.944 | large |
| p2 | SubCor | TP | -0.032 | -0.042 | -0.021 | 19 | -6.325 | 0.000 | **** | -1.414 | large |
| p2 | VAN | DAN | 0.003 | -0.005 | 0.011 | 19 | 0.900 | 1.000 | ns | 0.201 | small |
| p2 | VAN | DMN | 0.017 | 0.012 | 0.022 | 19 | 6.885 | 0.000 | **** | 1.539 | large |
| p2 | VAN | Limb | -0.025 | -0.033 | -0.017 | 19 | -6.877 | 0.000 | **** | -1.538 | large |
| p2 | VAN | SubCor | -0.001 | -0.013 | 0.011 | 19 | -0.183 | 1.000 | ns | -0.041 | negligible |
| p2 | VAN | TP | -0.033 | -0.036 | -0.029 | 19 | -18.509 | 0.000 | **** | -4.139 | large |
| p2 | Vis | DAN | 0.001 | -0.008 | 0.010 | 19 | 0.215 | 1.000 | ns | 0.048 | negligible |
| p2 | Vis | DMN | 0.015 | 0.007 | 0.023 | 19 | 3.876 | 0.012 | * | 0.867 | large |
| p2 | Vis | FPN | 0.026 | 0.018 | 0.034 | 19 | 6.714 | 0.000 | **** | 1.501 | large |
| p2 | Vis | Limb | -0.028 | -0.037 | -0.018 | 19 | -5.800 | 0.000 | *** | -1.297 | large |
| p2 | Vis | SM | -0.028 | -0.034 | -0.021 | 19 | -9.195 | 0.000 | **** | -2.056 | large |
| p2 | Vis | SubCor | -0.003 | -0.014 | 0.007 | 19 | -0.678 | 1.000 | ns | -0.152 | negligible |
| p2 | Vis | TP | -0.035 | -0.040 | -0.030 | 19 | -13.975 | 0.000 | **** | -3.125 | large |
| p2 | Vis | VAN | -0.002 | -0.007 | 0.002 | 19 | -1.050 | 1.000 | ns | -0.235 | small |
6.5 Network Measures Analysis
보조적인 분석으로 Connectivity Matrix에 대한 Network 분석을 수행한다. 네트워크 분석은 복잡한 연결 구조를 Node(ROI), Edge 또는 Link(ROI 간 Fuunctional Connectivity)의 개념을 통해 정의하고, 이 들간의 집중도, 분산도, 강도 등을 분석하여 전체 네트워크 구조에 대한 특징을 확인한다. 여기서는 전체 brain connectivity의 Global Network Measure로 Modularity와 Global Efficiency를 분석하였다.
Modularity는 전체 Network의 연결 구조가 얼마나 잘 Community Structure로 구분되는지를 Louvain의 알고리즘을 통해 계산한다. 쉽게 말해서, 전체 네트워크가 개별 Community Structure로 분할되는 정도를 나타내는 것으로 네트워크가 기능적으로 Segregation이 되는지를 나타낸다.
Global Efficiency는 떨어져있는 노드 간의 연결 효율성을 나타내는 Path Length의 역술 계산되며, 전체 네트워크의 정보 전달 수용력을 반영한다. 높은 Global efficiency는 전체 네트워크에 속해있는 떨어져있논 노드들이 서로 효율적으로 정보 전달을 한다는 것(높은 연결성 정도)을 나타내는 것으로 네트워크 간의 통합을 나타낸다고 할 수 있다.
아래에서는 Modularity와 Global Efficiency가 구획 간 차이가 있는지를 살펴본다.
## FC
r11 <- read.csv("py_output/sFC_net_v2.csv", header = T)
r11_l <- r11 %>% dplyr::filter(sn %in% targ_sn)
r11_l$sn = factor(r11_l$sn)
r11_l$net = factor(r11_l$net,
levels = c('All', 'Vis', 'SM', 'FPN',
'VAN', 'DAN', 'DMN', 'Limb', 'SubCor','TP'),
labels = c('All', 'Vis', 'SM', 'FPN',
'VAN', 'DAN', 'DMN', 'Limb', 'SubCor','TP'))
r11_l$idx = factor(r11_l$idx)
r11_l$part = factor(r11_l$part,
levels = c(1,2),
labels = c('p1','p2'))
## Behavior
r11_behav <- read.csv("data/aniFCnet_behav.csv", header = T)
glimpse(r11_behav, width = 80)
## Rows: 630
## Columns: 7
## $ Idx <int> 26, 21, 12, 22, 7, 6, 4, 30, 29, 14, 5, 10, 28, 17, 19, 15…
## $ num <int> 26, 21, 12, 22, 7, 6, 4, 30, 29, 14, 5, 10, 28, 17, 19, 15…
## $ stimIdx <int> 2, 9, 10, 13, 15, 24, 25, 33, 44, 49, 58, 62, 68, 74, 81, …
## $ sn <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ correctness <int> 1, 1, 0, 0, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ scores <int> 9, 9, 1, 1, 7, 9, 9, 1, 1, 7, 8, 9, 6, 6, 8, 9, 9, 6, 9, 6…
## $ check <int> 0, 0, 1, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
r11_behav <- r11_behav %>% dplyr::filter(sn %in% targ_sn)
r11_behav$sn = factor(r11_behav$sn)
r11_behav$idx = factor(r11_behav$stimIdx)
r11_behav$corr = r11_behav$correctness
r11_behav <- r11_behav %>% dplyr::select(sn, idx, corr, scores, check)
r11_1 <- merge(r11_l, r11_behav, by = c("sn", "idx"))
r11_2 <- r11_1
#r11_2 <- r11_1 %>% filter(corr == 1, check != 1)6.5.1 Modularity
Modularity에 대한 요약과 통계 분석을 수행한다.
# subject-level, long format
r11_allL <- r11_2 %>% dplyr::filter(net == "All") %>%
group_by(sn, part) %>%
dplyr::summarise(r=mean(md1)) %>%
ungroup()
## `summarise()` has grouped output by 'sn'. You can override using the `.groups` argument.
# summary table: grand mean
r11_allG <- r11_allL %>% group_by( part) %>%
dplyr::summarise(r.m = mean(r), r.sd = sd(r)) %>%
ungroup()
r11_allG$r.se <- Rmisc::summarySEwithin(data = r11_allL, measurevar = "r",
idvar = "sn", withinvars = c("part"))$se
r11_allG$r.ci <- Rmisc::summarySEwithin(data = r11_allL, measurevar = "r",
idvar = "sn", withinvars = c("part"))$ci
r11_allG <- r11_allG %>%
mutate(lower.ci = r.m-r.ci,
upper.ci = r.m+r.ci,
lower.se = r.m-r.se,
upper.se = r.m+r.se)
r11_allG %>% dplyr::select(part, r.m) %>%
spread(key=part, value=r.m) %>% kable(digits=2)| p1 | p2 |
|---|---|
| 0.46 | 0.45 |
r11_allL.p1 <- r11_allL
r11_allG.p1 <- r11_allG
r11.p1.all.plot1 <- ggplot(data=r11_allL.p1, aes(x=part, y=r, fill=part, shpae=part)) +
stat_summary(fun = mean, geom = "bar", position="dodge",
na.rm = TRUE, alpha = .9, width = 0.8, color="black", size = 0.15) +
# facet_grid(.~net, scales="free_x", space = "free") +
# geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
geom_point(data=r11_allL.p1, aes(x=part, y=r, fill=part), position = position_dodge(width=0.8),
size=2, show.legend=F, color="gray90") +
geom_errorbar(data=r11_allG.p1, aes(x=part, y= r.m, ymin=r.m-r.ci, ymax=r.m+r.ci), width=.2,
position=position_dodge(.8), color = "black") +
# scale_x_discrete(labels=c("Within", "Between")) +
scale_fill_manual(values = c("#ED7D31", "#5B9BD5"), # c("#ED7D31", "#5B9BD5", "#70AD47"),
labels = c("First Half", "Second Half")) + scale_color_brewer(palette="Set2") +
coord_cartesian(ylim = c(0.35, 0.6), clip = "on") +
labs(x = "Part", y = "Modularity Score") +
ggtitle("Modularity") +
theme_bw(base_size = 18) +
theme(#axis.text.x=element_blank(),
#axis.ticks.x=element_blank(),
axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position="bottom")
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r11.p1.all.plot1
Modularity 통계 분석 결과는 아래와 같다.
r11_allL.1.tmp <- r11_allL
r11.aov1.tmp <- aov_ez(id="sn", dv="r", data = r11_allL.1.tmp, within = c("part"))
# summary(r11.aov1)
nice(r11.aov1.tmp, es="pes") %>% kable(digits=2)| Effect | df | MSE | F | pes | p.value |
|---|---|---|---|---|---|
| part | 1, 19 | 0.00 | 8.68 ** | .314 | .008 |
p_h1 <- r11_allL.1.tmp %>%
rstatix::pairwise_t_test(r ~ part,
p.adjust.method="holm",
paired=T, detailed=T) %>%
dplyr::select(group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r11_allL.1.tmp %>%
rstatix::cohens_d(r ~ part, paired=T, ci = F) %>%
dplyr::select(group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("group1", "group2")) %>% kable(digits=3)| group1 | group2 | estimate | conf.low | conf.high | df | statistic | p.adj | p.adj.signif | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|
| p1 | p2 | 0.011 | 0.003 | 0.018 | 19 | 2.947 | 0.008 | ** | 0.659 | moderate |
6.5.2 Global Efficiency
Global Efficiency에 대한 요약과 통계 분석을 수행한다.
# subject-level, long format
r11_allL <- r11_2 %>% dplyr::filter(net == "All") %>%
group_by(sn, part) %>%
dplyr::summarise(r=mean(ge)) %>%
ungroup()
## `summarise()` has grouped output by 'sn'. You can override using the `.groups` argument.
# summary table: grand mean
r11_allG <- r11_allL %>% group_by( part) %>%
dplyr::summarise(r.m = mean(r), r.sd = sd(r)) %>%
ungroup()
r11_allG$r.se <- Rmisc::summarySEwithin(data = r11_allL, measurevar = "r",
idvar = "sn", withinvars = c("part"))$se
r11_allG$r.ci <- Rmisc::summarySEwithin(data = r11_allL, measurevar = "r",
idvar = "sn", withinvars = c("part"))$ci
r11_allG <- r11_allG %>%
mutate(lower.ci = r.m-r.ci,
upper.ci = r.m+r.ci,
lower.se = r.m-r.se,
upper.se = r.m+r.se)
r11_allG %>% dplyr::select(part, r.m) %>%
spread(key=part, value=r.m) %>% kable(digits=2)| p1 | p2 |
|---|---|
| 0.26 | 0.24 |
r11_allL.p1 <- r11_allL
r11_allG.p1 <- r11_allG
r11.p1.all.plot1 <- ggplot(data=r11_allL.p1, aes(x=part, y=r, fill=part, shpae=part)) +
stat_summary(fun = mean, geom = "bar", position="dodge",
na.rm = TRUE, alpha = .9, width = 0.8, color="black", size = 0.15) +
# facet_grid(.~net, scales="free_x", space = "free") +
# geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
geom_point(data=r11_allL.p1, aes(x=part, y=r, fill=part), position = position_dodge(width=0.8),
size=2, show.legend=F, color="gray90") +
geom_errorbar(data=r11_allG.p1, aes(x=part, y= r.m, ymin=r.m-r.ci, ymax=r.m+r.ci), width=.2,
position=position_dodge(.8), color = "black") +
# scale_x_discrete(labels=c("Within", "Between")) +
scale_fill_manual(values = c("#ED7D31", "#5B9BD5"), # c("#ED7D31", "#5B9BD5", "#70AD47"),
labels = c("First Half", "Second Half")) + scale_color_brewer(palette="Set2") +
coord_cartesian(ylim = c(0.2, 0.3), clip = "on") +
labs(x = "Part", y = "Global Efficiency") +
ggtitle("Global Efficiency") +
theme_bw(base_size = 18) +
theme(#axis.text.x=element_blank(),
#axis.ticks.x=element_blank(),
axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position="bottom")
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r11.p1.all.plot1
Global Efficiency의 통계 분석 결과는 아래와 같다.
r11_allL.1.tmp <- r11_allL
r11.aov1.tmp <- aov_ez(id="sn", dv="r", data = r11_allL.1.tmp, within = c("part"))
# summary(r11.aov1)
nice(r11.aov1.tmp, es="pes") %>% kable(digits=2)| Effect | df | MSE | F | pes | p.value |
|---|---|---|---|---|---|
| part | 1, 19 | 0.00 | 374.64 *** | .952 | <.001 |
p_h1 <- r11_allL.1.tmp %>%
rstatix::pairwise_t_test(r ~ part,
p.adjust.method="holm",
paired=T, detailed=T) %>%
dplyr::select(group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r11_allL.1.tmp %>%
rstatix::cohens_d(r ~ part, paired=T, ci = F) %>%
dplyr::select(group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("group1", "group2")) %>% kable(digits=3)| group1 | group2 | estimate | conf.low | conf.high | df | statistic | p.adj | p.adj.signif | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|
| p1 | p2 | 0.017 | 0.015 | 0.018 | 19 | 19.356 | 0 | **** | 4.328 | large |
6.5.3 Participation Coefficient
Participation Coefficiecny
# subject-level, long format
r11_allL <- r11_2 %>%
dplyr::filter(net !="All") %>%
group_by(sn, net, part) %>%
dplyr::summarise(r=mean(p_pc)) %>%
ungroup()
## `summarise()` has grouped output by 'sn', 'net'. You can override using the `.groups` argument.
# summary table: grand mean
r11_allG <- r11_allL %>% group_by(net, part) %>%
dplyr::summarise(r.m = mean(r), r.sd = sd(r)) %>%
ungroup()
## `summarise()` has grouped output by 'net'. You can override using the `.groups` argument.
r11_allG$r.se <- Rmisc::summarySEwithin(data = r11_allL, measurevar = "r",
idvar = "sn", withinvars = c("net","part"))$se
r11_allG$r.ci <- Rmisc::summarySEwithin(data = r11_allL, measurevar = "r",
idvar = "sn", withinvars = c("net","part"))$ci
r11_allG <- r11_allG %>%
mutate(lower.ci = r.m-r.ci,
upper.ci = r.m+r.ci,
lower.se = r.m-r.se,
upper.se = r.m+r.se)
r11_allG %>% dplyr::select(net, part, r.m) %>%
spread(key=part, value=r.m) %>% kable(digits=2)| net | p1 | p2 |
|---|---|---|
| Vis | 0.79 | 0.79 |
| SM | 0.81 | 0.81 |
| FPN | 0.77 | 0.77 |
| VAN | 0.79 | 0.78 |
| DAN | 0.80 | 0.80 |
| DMN | 0.81 | 0.81 |
| Limb | 0.78 | 0.78 |
| SubCor | 0.83 | 0.83 |
| TP | 0.78 | 0.79 |
r11_allL.p1 <- r11_allL
r11_allG.p1 <- r11_allG
r11.p1.all.plot1 <- ggplot(data=r11_allL.p1, aes(x=part, y=r, fill=part, shpae=part)) +
stat_summary(fun = mean, geom = "bar", position="dodge",
na.rm = TRUE, alpha = .9, width = 0.8, color="black", size = 0.15) +
facet_grid(.~net, scales="free_x", space = "free") +
geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
geom_point(data=r11_allL.p1, aes(x=part, y=r, fill=part), position = position_dodge(width=0.8),
size=2, show.legend=F, color="gray90") +
geom_errorbar(data=r11_allG.p1, aes(x=part, y= r.m, ymin=r.m-r.ci, ymax=r.m+r.ci), width=.2,
position=position_dodge(.8), color = "black") +
# scale_x_discrete(labels=c("Within", "Between")) +
scale_fill_manual(values = c("#ED7D31", "#5B9BD5"), # c("#ED7D31", "#5B9BD5", "#70AD47"),
labels = c("First Half", "Second Half")) + scale_color_brewer(palette="Set2") +
# coord_cartesian(ylim = c(-0.4, 0.4), clip = "on") +
labs(x = "Part", y = "Participation Coefficient") +
ggtitle("Participation Coefficient") +
theme_bw(base_size = 18) +
theme(#axis.text.x=element_blank(),
#axis.ticks.x=element_blank(),
axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position="bottom")
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r11.p1.all.plot1
Participation Coefficient 통계 분석 결과
r11_allL.1.tmp <- r11_allL
r11.aov1.tmp <- aov_ez(id="sn", dv="r", data = r11_allL.1.tmp, within = c("net","part"))
# summary(r11.aov1)
nice(r11.aov1.tmp, es="pes") %>% kable(digits=2)| Effect | df | MSE | F | pes | p.value |
|---|---|---|---|---|---|
| net | 2.03, 38.61 | 0.00 | 24.74 *** | .566 | <.001 |
| part | 1, 19 | 0.00 | 3.65 + | .161 | .071 |
| net:part | 4.89, 92.94 | 0.00 | 5.71 *** | .231 | <.001 |
p_h1 <- r11_allL.1.tmp %>% group_by(net) %>%
rstatix::pairwise_t_test(r ~ part,
p.adjust.method="holm",
paired=T, detailed=T) %>%
dplyr::select(net, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r11_allL.1.tmp %>% group_by(net) %>%
rstatix::cohens_d(r ~ part, paired=T, ci = F) %>%
dplyr::select(net, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("net", "group1", "group2")) %>% kable(digits=3)| net | group1 | group2 | estimate | conf.low | conf.high | df | statistic | p.adj | p.adj.signif | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|
| DAN | p1 | p2 | 0.002 | 0.000 | 0.004 | 19 | 2.601 | 0.018 | * | 0.582 | moderate |
| DMN | p1 | p2 | 0.001 | 0.000 | 0.002 | 19 | 1.588 | 0.129 | ns | 0.355 | small |
| FPN | p1 | p2 | 0.003 | 0.000 | 0.005 | 19 | 2.278 | 0.034 | * | 0.509 | moderate |
| Limb | p1 | p2 | 0.003 | 0.000 | 0.005 | 19 | 2.503 | 0.022 | * | 0.560 | moderate |
| SM | p1 | p2 | -0.001 | -0.002 | 0.001 | 19 | -0.923 | 0.367 | ns | -0.206 | small |
| SubCor | p1 | p2 | 0.000 | -0.002 | 0.002 | 19 | 0.162 | 0.873 | ns | 0.036 | negligible |
| TP | p1 | p2 | -0.002 | -0.005 | 0.002 | 19 | -0.971 | 0.344 | ns | -0.217 | small |
| VAN | p1 | p2 | 0.004 | 0.003 | 0.006 | 19 | 5.160 | 0.000 | **** | 1.154 | large |
| Vis | p1 | p2 | 0.000 | -0.002 | 0.001 | 19 | -0.356 | 0.726 | ns | -0.080 | negligible |
p_h1 <- r11_allL.1.tmp %>% group_by(part) %>%
rstatix::pairwise_t_test(r ~ net,
p.adjust.method="holm",
paired=T, detailed=T) %>%
dplyr::select(part, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r11_allL.1.tmp %>% group_by(part) %>%
rstatix::cohens_d(r ~ net, paired=T, ci = F) %>%
dplyr::select(part, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("part", "group1", "group2")) %>% kable(digits=3)| part | group1 | group2 | estimate | conf.low | conf.high | df | statistic | p.adj | p.adj.signif | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|
| p1 | DAN | DMN | -0.007 | -0.010 | -0.004 | 19 | -5.351 | 0.001 | *** | -1.196 | large |
| p1 | DAN | Limb | 0.018 | 0.012 | 0.023 | 19 | 6.379 | 0.000 | **** | 1.426 | large |
| p1 | DAN | SubCor | -0.026 | -0.030 | -0.023 | 19 | -17.263 | 0.000 | **** | -3.860 | large |
| p1 | DAN | TP | 0.015 | 0.008 | 0.021 | 19 | 4.619 | 0.003 | ** | 1.033 | large |
| p1 | DMN | Limb | 0.025 | 0.019 | 0.030 | 19 | 9.061 | 0.000 | **** | 2.026 | large |
| p1 | DMN | SubCor | -0.019 | -0.021 | -0.017 | 19 | -21.475 | 0.000 | **** | -4.802 | large |
| p1 | DMN | TP | 0.022 | 0.016 | 0.027 | 19 | 8.435 | 0.000 | **** | 1.886 | large |
| p1 | FPN | DAN | -0.031 | -0.037 | -0.026 | 19 | -11.915 | 0.000 | **** | -2.664 | large |
| p1 | FPN | DMN | -0.038 | -0.044 | -0.032 | 19 | -14.117 | 0.000 | **** | -3.157 | large |
| p1 | FPN | Limb | -0.014 | -0.018 | -0.009 | 19 | -6.578 | 0.000 | **** | -1.471 | large |
| p1 | FPN | SubCor | -0.057 | -0.063 | -0.052 | 19 | -22.232 | 0.000 | **** | -4.971 | large |
| p1 | FPN | TP | -0.016 | -0.022 | -0.010 | 19 | -5.687 | 0.000 | *** | -1.272 | large |
| p1 | FPN | VAN | -0.019 | -0.023 | -0.014 | 19 | -9.297 | 0.000 | **** | -2.079 | large |
| p1 | Limb | SubCor | -0.044 | -0.049 | -0.038 | 19 | -16.639 | 0.000 | **** | -3.721 | large |
| p1 | Limb | TP | -0.003 | -0.009 | 0.004 | 19 | -0.931 | 1.000 | ns | -0.208 | small |
| p1 | SM | DAN | 0.006 | -0.007 | 0.018 | 19 | 0.972 | 1.000 | ns | 0.217 | small |
| p1 | SM | DMN | -0.001 | -0.013 | 0.011 | 19 | -0.231 | 1.000 | ns | -0.052 | negligible |
| p1 | SM | FPN | 0.037 | 0.023 | 0.051 | 19 | 5.518 | 0.001 | *** | 1.234 | large |
| p1 | SM | Limb | 0.023 | 0.010 | 0.036 | 19 | 3.750 | 0.022 | * | 0.838 | large |
| p1 | SM | SubCor | -0.021 | -0.032 | -0.009 | 19 | -3.723 | 0.022 | * | -0.832 | large |
| p1 | SM | TP | 0.020 | 0.008 | 0.033 | 19 | 3.366 | 0.046 | * | 0.753 | moderate |
| p1 | SM | VAN | 0.018 | 0.005 | 0.031 | 19 | 2.918 | 0.106 | ns | 0.652 | moderate |
| p1 | SubCor | TP | 0.041 | 0.036 | 0.046 | 19 | 16.103 | 0.000 | **** | 3.601 | large |
| p1 | VAN | DAN | -0.012 | -0.016 | -0.009 | 19 | -7.431 | 0.000 | **** | -1.662 | large |
| p1 | VAN | DMN | -0.019 | -0.024 | -0.015 | 19 | -9.306 | 0.000 | **** | -2.081 | large |
| p1 | VAN | Limb | 0.005 | 0.000 | 0.010 | 19 | 2.034 | 0.618 | ns | 0.455 | small |
| p1 | VAN | SubCor | -0.039 | -0.043 | -0.034 | 19 | -17.822 | 0.000 | **** | -3.985 | large |
| p1 | VAN | TP | 0.002 | -0.005 | 0.009 | 19 | 0.651 | 1.000 | ns | 0.146 | negligible |
| p1 | Vis | DAN | -0.005 | -0.021 | 0.010 | 19 | -0.688 | 1.000 | ns | -0.154 | negligible |
| p1 | Vis | DMN | -0.012 | -0.028 | 0.004 | 19 | -1.583 | 1.000 | ns | -0.354 | small |
| p1 | Vis | FPN | 0.026 | 0.008 | 0.044 | 19 | 3.053 | 0.085 | ns | 0.683 | moderate |
| p1 | Vis | Limb | 0.012 | -0.004 | 0.029 | 19 | 1.577 | 1.000 | ns | 0.353 | small |
| p1 | Vis | SM | -0.011 | -0.023 | 0.002 | 19 | -1.801 | 0.876 | ns | -0.403 | small |
| p1 | Vis | SubCor | -0.031 | -0.047 | -0.016 | 19 | -4.184 | 0.009 | ** | -0.936 | large |
| p1 | Vis | TP | 0.010 | -0.009 | 0.028 | 19 | 1.102 | 1.000 | ns | 0.246 | small |
| p1 | Vis | VAN | 0.007 | -0.009 | 0.024 | 19 | 0.947 | 1.000 | ns | 0.212 | small |
| p2 | DAN | DMN | -0.008 | -0.011 | -0.005 | 19 | -5.992 | 0.000 | *** | -1.340 | large |
| p2 | DAN | Limb | 0.018 | 0.013 | 0.024 | 19 | 6.527 | 0.000 | **** | 1.460 | large |
| p2 | DAN | SubCor | -0.028 | -0.032 | -0.025 | 19 | -16.407 | 0.000 | **** | -3.669 | large |
| p2 | DAN | TP | 0.011 | 0.005 | 0.017 | 19 | 3.774 | 0.020 | * | 0.844 | large |
| p2 | DMN | Limb | 0.026 | 0.020 | 0.032 | 19 | 9.256 | 0.000 | **** | 2.070 | large |
| p2 | DMN | SubCor | -0.020 | -0.023 | -0.018 | 19 | -17.427 | 0.000 | **** | -3.897 | large |
| p2 | DMN | TP | 0.019 | 0.013 | 0.025 | 19 | 6.655 | 0.000 | **** | 1.488 | large |
| p2 | FPN | DAN | -0.032 | -0.037 | -0.027 | 19 | -12.704 | 0.000 | **** | -2.841 | large |
| p2 | FPN | DMN | -0.040 | -0.045 | -0.034 | 19 | -15.155 | 0.000 | **** | -3.389 | large |
| p2 | FPN | Limb | -0.013 | -0.018 | -0.009 | 19 | -6.394 | 0.000 | **** | -1.430 | large |
| p2 | FPN | SubCor | -0.060 | -0.066 | -0.055 | 19 | -23.036 | 0.000 | **** | -5.151 | large |
| p2 | FPN | TP | -0.021 | -0.028 | -0.014 | 19 | -6.047 | 0.000 | *** | -1.352 | large |
| p2 | FPN | VAN | -0.017 | -0.021 | -0.013 | 19 | -9.650 | 0.000 | **** | -2.158 | large |
| p2 | Limb | SubCor | -0.047 | -0.052 | -0.041 | 19 | -17.317 | 0.000 | **** | -3.872 | large |
| p2 | Limb | TP | -0.007 | -0.014 | -0.001 | 19 | -2.336 | 0.337 | ns | -0.522 | moderate |
| p2 | SM | DAN | 0.008 | -0.004 | 0.021 | 19 | 1.382 | 1.000 | ns | 0.309 | small |
| p2 | SM | DMN | 0.000 | -0.012 | 0.013 | 19 | 0.084 | 1.000 | ns | 0.019 | negligible |
| p2 | SM | FPN | 0.040 | 0.026 | 0.054 | 19 | 5.936 | 0.000 | *** | 1.327 | large |
| p2 | SM | Limb | 0.027 | 0.014 | 0.040 | 19 | 4.204 | 0.009 | ** | 0.940 | large |
| p2 | SM | SubCor | -0.020 | -0.032 | -0.008 | 19 | -3.498 | 0.034 | * | -0.782 | moderate |
| p2 | SM | TP | 0.020 | 0.007 | 0.033 | 19 | 3.166 | 0.061 | ns | 0.708 | moderate |
| p2 | SM | VAN | 0.023 | 0.010 | 0.037 | 19 | 3.532 | 0.033 | * | 0.790 | moderate |
| p2 | SubCor | TP | 0.039 | 0.034 | 0.045 | 19 | 14.466 | 0.000 | **** | 3.235 | large |
| p2 | VAN | DAN | -0.015 | -0.019 | -0.011 | 19 | -7.465 | 0.000 | **** | -1.669 | large |
| p2 | VAN | DMN | -0.023 | -0.028 | -0.018 | 19 | -9.810 | 0.000 | **** | -2.194 | large |
| p2 | VAN | Limb | 0.004 | -0.002 | 0.009 | 19 | 1.332 | 1.000 | ns | 0.298 | small |
| p2 | VAN | SubCor | -0.043 | -0.049 | -0.038 | 19 | -16.883 | 0.000 | **** | -3.775 | large |
| p2 | VAN | TP | -0.004 | -0.012 | 0.005 | 19 | -0.950 | 1.000 | ns | -0.212 | small |
| p2 | Vis | DAN | -0.003 | -0.019 | 0.013 | 19 | -0.363 | 1.000 | ns | -0.081 | negligible |
| p2 | Vis | DMN | -0.011 | -0.027 | 0.005 | 19 | -1.416 | 1.000 | ns | -0.317 | small |
| p2 | Vis | FPN | 0.029 | 0.012 | 0.047 | 19 | 3.473 | 0.034 | * | 0.777 | moderate |
| p2 | Vis | Limb | 0.016 | -0.001 | 0.033 | 19 | 1.948 | 0.641 | ns | 0.435 | small |
| p2 | Vis | SM | -0.011 | -0.023 | 0.001 | 19 | -1.966 | 0.641 | ns | -0.440 | small |
| p2 | Vis | SubCor | -0.031 | -0.047 | -0.015 | 19 | -4.167 | 0.009 | ** | -0.932 | large |
| p2 | Vis | TP | 0.008 | -0.010 | 0.027 | 19 | 0.962 | 1.000 | ns | 0.215 | small |
| p2 | Vis | VAN | 0.012 | -0.005 | 0.029 | 19 | 1.515 | 1.000 | ns | 0.339 | small |
6.5.4 Local Efficiecny
Local Efficiency, 노드 별 Effciecny
# subject-level, long format
r11_allL <- r11_2 %>%
dplyr::filter(net !="All") %>%
group_by(sn, net, part) %>%
dplyr::summarise(r=mean(le)) %>%
ungroup()
## `summarise()` has grouped output by 'sn', 'net'. You can override using the `.groups` argument.
# summary table: grand mean
r11_allG <- r11_allL %>% group_by(net, part) %>%
dplyr::summarise(r.m = mean(r), r.sd = sd(r)) %>%
ungroup()
## `summarise()` has grouped output by 'net'. You can override using the `.groups` argument.
r11_allG$r.se <- Rmisc::summarySEwithin(data = r11_allL, measurevar = "r",
idvar = "sn", withinvars = c("net","part"))$se
r11_allG$r.ci <- Rmisc::summarySEwithin(data = r11_allL, measurevar = "r",
idvar = "sn", withinvars = c("net","part"))$ci
r11_allG <- r11_allG %>%
mutate(lower.ci = r.m-r.ci,
upper.ci = r.m+r.ci,
lower.se = r.m-r.se,
upper.se = r.m+r.se)
r11_allG %>% dplyr::select(net, part, r.m) %>%
spread(key=part, value=r.m) %>% kable(digits=2)| net | p1 | p2 |
|---|---|---|
| Vis | 0.22 | 0.19 |
| SM | 0.22 | 0.20 |
| FPN | 0.23 | 0.21 |
| VAN | 0.23 | 0.21 |
| DAN | 0.23 | 0.22 |
| DMN | 0.22 | 0.21 |
| Limb | 0.23 | 0.21 |
| SubCor | 0.20 | 0.18 |
| TP | 0.23 | 0.22 |
r11_allL.p1 <- r11_allL
r11_allG.p1 <- r11_allG
r11.p1.all.plot1 <- ggplot(data=r11_allL.p1, aes(x=part, y=r, fill=part, shpae=part)) +
stat_summary(fun = mean, geom = "bar", position="dodge",
na.rm = TRUE, alpha = .9, width = 0.8, color="black", size = 0.15) +
facet_grid(.~net, scales="free_x", space = "free") +
geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
geom_point(data=r11_allL.p1, aes(x=part, y=r, fill=part), position = position_dodge(width=0.8),
size=2, show.legend=F, color="gray90") +
geom_errorbar(data=r11_allG.p1, aes(x=part, y= r.m, ymin=r.m-r.ci, ymax=r.m+r.ci), width=.2,
position=position_dodge(.8), color = "black") +
# scale_x_discrete(labels=c("Within", "Between")) +
scale_fill_manual(values = c("#ED7D31", "#5B9BD5"), # c("#ED7D31", "#5B9BD5", "#70AD47"),
labels = c("First Half", "Second Half")) + scale_color_brewer(palette="Set2") +
# coord_cartesian(ylim = c(-0.4, 0.4), clip = "on") +
labs(x = "Part", y = "Local Efficiency") +
ggtitle("Local Efficiency") +
theme_bw(base_size = 18) +
theme(#axis.text.x=element_blank(),
#axis.ticks.x=element_blank(),
axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position="bottom")
# ggsave("fig1_1.fmri.jpg", plot = r3.p1.all.plot1, width=6, height=6, unit='in', dpi=600)
r11.p1.all.plot1
Local Efficiency 통계 분석 결과
r11_allL.1.tmp <- r11_allL
r11.aov1.tmp <- aov_ez(id="sn", dv="r", data = r11_allL.1.tmp, within = c("net","part"))
# summary(r11.aov1)
nice(r11.aov1.tmp, es="pes") %>% kable(digits=2)| Effect | df | MSE | F | pes | p.value |
|---|---|---|---|---|---|
| net | 3.80, 72.29 | 0.00 | 69.10 *** | .784 | <.001 |
| part | 1, 19 | 0.00 | 190.62 *** | .909 | <.001 |
| net:part | 4.78, 90.90 | 0.00 | 5.44 *** | .222 | <.001 |
p_h1 <- r11_allL.1.tmp %>% group_by(net) %>%
rstatix::pairwise_t_test(r ~ part,
p.adjust.method="holm",
paired=T, detailed=T) %>%
dplyr::select(net, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r11_allL.1.tmp %>% group_by(net) %>%
rstatix::cohens_d(r ~ part, paired=T, ci = F) %>%
dplyr::select(net, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("net", "group1", "group2")) %>% kable(digits=3)| net | group1 | group2 | estimate | conf.low | conf.high | df | statistic | p.adj | p.adj.signif | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|
| DAN | p1 | p2 | 0.017 | 0.014 | 0.021 | 19 | 10.521 | 0 | **** | 2.353 | large |
| DMN | p1 | p2 | 0.017 | 0.015 | 0.020 | 19 | 15.029 | 0 | **** | 3.360 | large |
| FPN | p1 | p2 | 0.020 | 0.017 | 0.024 | 19 | 11.619 | 0 | **** | 2.598 | large |
| Limb | p1 | p2 | 0.016 | 0.013 | 0.020 | 19 | 9.621 | 0 | **** | 2.151 | large |
| SM | p1 | p2 | 0.019 | 0.016 | 0.023 | 19 | 10.725 | 0 | **** | 2.398 | large |
| SubCor | p1 | p2 | 0.016 | 0.014 | 0.019 | 19 | 12.012 | 0 | **** | 2.686 | large |
| TP | p1 | p2 | 0.019 | 0.015 | 0.023 | 19 | 9.224 | 0 | **** | 2.063 | large |
| VAN | p1 | p2 | 0.017 | 0.013 | 0.020 | 19 | 11.227 | 0 | **** | 2.510 | large |
| Vis | p1 | p2 | 0.024 | 0.020 | 0.028 | 19 | 11.931 | 0 | **** | 2.668 | large |
p_h1 <- r11_allL.1.tmp %>% group_by(part) %>%
rstatix::pairwise_t_test(r ~ net,
p.adjust.method="holm",
paired=T, detailed=T) %>%
dplyr::select(part, group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- r11_allL.1.tmp %>% group_by(part) %>%
rstatix::cohens_d(r ~ net, paired=T, ci = F) %>%
dplyr::select(part, group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("part", "group1", "group2")) %>% kable(digits=3)| part | group1 | group2 | estimate | conf.low | conf.high | df | statistic | p.adj | p.adj.signif | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|
| p1 | DAN | DMN | 0.009 | 0.006 | 0.012 | 19 | 6.077 | 0.000 | *** | 1.359 | large |
| p1 | DAN | Limb | 0.006 | 0.002 | 0.010 | 19 | 3.430 | 0.037 | * | 0.767 | moderate |
| p1 | DAN | SubCor | 0.034 | 0.031 | 0.038 | 19 | 20.872 | 0.000 | **** | 4.667 | large |
| p1 | DAN | TP | -0.001 | -0.007 | 0.004 | 19 | -0.511 | 1.000 | ns | -0.114 | negligible |
| p1 | DMN | Limb | -0.002 | -0.005 | 0.001 | 19 | -1.579 | 0.678 | ns | -0.353 | small |
| p1 | DMN | SubCor | 0.026 | 0.022 | 0.029 | 19 | 16.092 | 0.000 | **** | 3.598 | large |
| p1 | DMN | TP | -0.010 | -0.016 | -0.004 | 19 | -3.494 | 0.034 | * | -0.781 | moderate |
| p1 | FPN | DAN | 0.001 | -0.002 | 0.005 | 19 | 0.736 | 1.000 | ns | 0.165 | negligible |
| p1 | FPN | DMN | 0.010 | 0.007 | 0.013 | 19 | 7.193 | 0.000 | **** | 1.608 | large |
| p1 | FPN | Limb | 0.008 | 0.005 | 0.010 | 19 | 5.937 | 0.000 | *** | 1.328 | large |
| p1 | FPN | SubCor | 0.035 | 0.032 | 0.039 | 19 | 20.955 | 0.000 | **** | 4.686 | large |
| p1 | FPN | TP | 0.000 | -0.007 | 0.006 | 19 | -0.078 | 1.000 | ns | -0.018 | negligible |
| p1 | FPN | VAN | 0.005 | 0.002 | 0.008 | 19 | 4.017 | 0.013 | * | 0.898 | large |
| p1 | Limb | SubCor | 0.028 | 0.024 | 0.032 | 19 | 14.554 | 0.000 | **** | 3.254 | large |
| p1 | Limb | TP | -0.008 | -0.014 | -0.001 | 19 | -2.528 | 0.184 | ns | -0.565 | moderate |
| p1 | SM | DAN | -0.011 | -0.016 | -0.007 | 19 | -5.902 | 0.000 | *** | -1.320 | large |
| p1 | SM | DMN | -0.003 | -0.007 | 0.001 | 19 | -1.375 | 0.740 | ns | -0.308 | small |
| p1 | SM | FPN | -0.013 | -0.016 | -0.009 | 19 | -7.150 | 0.000 | **** | -1.599 | large |
| p1 | SM | Limb | -0.005 | -0.009 | -0.001 | 19 | -2.401 | 0.214 | ns | -0.537 | moderate |
| p1 | SM | SubCor | 0.023 | 0.018 | 0.028 | 19 | 9.614 | 0.000 | **** | 2.150 | large |
| p1 | SM | TP | -0.013 | -0.019 | -0.007 | 19 | -4.268 | 0.007 | ** | -0.954 | large |
| p1 | SM | VAN | -0.007 | -0.011 | -0.003 | 19 | -3.884 | 0.016 | * | -0.869 | large |
| p1 | SubCor | TP | -0.036 | -0.042 | -0.029 | 19 | -11.433 | 0.000 | **** | -2.557 | large |
| p1 | VAN | DAN | -0.004 | -0.007 | -0.001 | 19 | -3.117 | 0.062 | ns | -0.697 | moderate |
| p1 | VAN | DMN | 0.005 | 0.003 | 0.006 | 19 | 5.856 | 0.000 | *** | 1.310 | large |
| p1 | VAN | Limb | 0.002 | -0.001 | 0.005 | 19 | 1.663 | 0.678 | ns | 0.372 | small |
| p1 | VAN | SubCor | 0.030 | 0.027 | 0.034 | 19 | 17.843 | 0.000 | **** | 3.990 | large |
| p1 | VAN | TP | -0.005 | -0.012 | 0.001 | 19 | -1.838 | 0.572 | ns | -0.411 | small |
| p1 | Vis | DAN | -0.017 | -0.022 | -0.011 | 19 | -6.589 | 0.000 | **** | -1.473 | large |
| p1 | Vis | DMN | -0.008 | -0.013 | -0.003 | 19 | -3.371 | 0.039 | * | -0.754 | moderate |
| p1 | Vis | FPN | -0.018 | -0.023 | -0.013 | 19 | -7.720 | 0.000 | **** | -1.726 | large |
| p1 | Vis | Limb | -0.010 | -0.017 | -0.004 | 19 | -3.526 | 0.034 | * | -0.788 | moderate |
| p1 | Vis | SM | -0.005 | -0.010 | -0.001 | 19 | -2.642 | 0.161 | ns | -0.591 | moderate |
| p1 | Vis | SubCor | 0.017 | 0.012 | 0.023 | 19 | 6.310 | 0.000 | *** | 1.411 | large |
| p1 | Vis | TP | -0.018 | -0.026 | -0.011 | 19 | -5.003 | 0.001 | ** | -1.119 | large |
| p1 | Vis | VAN | -0.013 | -0.018 | -0.008 | 19 | -5.570 | 0.000 | *** | -1.246 | large |
| p2 | DAN | DMN | 0.009 | 0.006 | 0.011 | 19 | 6.287 | 0.000 | *** | 1.406 | large |
| p2 | DAN | Limb | 0.005 | 0.002 | 0.009 | 19 | 3.012 | 0.086 | ns | 0.673 | moderate |
| p2 | DAN | SubCor | 0.033 | 0.030 | 0.036 | 19 | 22.745 | 0.000 | **** | 5.086 | large |
| p2 | DAN | TP | 0.000 | -0.004 | 0.005 | 19 | 0.092 | 0.927 | ns | 0.021 | negligible |
| p2 | DMN | Limb | -0.003 | -0.007 | 0.000 | 19 | -2.096 | 0.398 | ns | -0.469 | small |
| p2 | DMN | SubCor | 0.025 | 0.022 | 0.027 | 19 | 20.832 | 0.000 | **** | 4.658 | large |
| p2 | DMN | TP | -0.008 | -0.013 | -0.004 | 19 | -4.003 | 0.010 | ** | -0.895 | large |
| p2 | FPN | DAN | -0.002 | -0.005 | 0.001 | 19 | -1.278 | 0.895 | ns | -0.286 | small |
| p2 | FPN | DMN | 0.007 | 0.004 | 0.009 | 19 | 5.168 | 0.001 | *** | 1.156 | large |
| p2 | FPN | Limb | 0.003 | 0.001 | 0.006 | 19 | 2.817 | 0.110 | ns | 0.630 | moderate |
| p2 | FPN | SubCor | 0.031 | 0.028 | 0.035 | 19 | 21.083 | 0.000 | **** | 4.714 | large |
| p2 | FPN | TP | -0.002 | -0.006 | 0.003 | 19 | -0.754 | 0.920 | ns | -0.169 | negligible |
| p2 | FPN | VAN | 0.001 | -0.001 | 0.004 | 19 | 1.308 | 0.895 | ns | 0.292 | small |
| p2 | Limb | SubCor | 0.028 | 0.024 | 0.032 | 19 | 15.367 | 0.000 | **** | 3.436 | large |
| p2 | Limb | TP | -0.005 | -0.011 | 0.000 | 19 | -1.912 | 0.498 | ns | -0.428 | small |
| p2 | SM | DAN | -0.014 | -0.017 | -0.010 | 19 | -7.972 | 0.000 | **** | -1.783 | large |
| p2 | SM | DMN | -0.005 | -0.009 | -0.001 | 19 | -2.895 | 0.102 | ns | -0.647 | moderate |
| p2 | SM | FPN | -0.012 | -0.015 | -0.009 | 19 | -7.813 | 0.000 | **** | -1.747 | large |
| p2 | SM | Limb | -0.008 | -0.012 | -0.004 | 19 | -4.294 | 0.005 | ** | -0.960 | large |
| p2 | SM | SubCor | 0.020 | 0.016 | 0.024 | 19 | 10.465 | 0.000 | **** | 2.340 | large |
| p2 | SM | TP | -0.013 | -0.020 | -0.007 | 19 | -4.504 | 0.004 | ** | -1.007 | large |
| p2 | SM | VAN | -0.010 | -0.014 | -0.007 | 19 | -6.005 | 0.000 | *** | -1.343 | large |
| p2 | SubCor | TP | -0.033 | -0.038 | -0.028 | 19 | -14.247 | 0.000 | **** | -3.186 | large |
| p2 | VAN | DAN | -0.003 | -0.006 | -0.001 | 19 | -2.762 | 0.112 | ns | -0.618 | moderate |
| p2 | VAN | DMN | 0.005 | 0.003 | 0.007 | 19 | 5.795 | 0.000 | *** | 1.296 | large |
| p2 | VAN | Limb | 0.002 | -0.001 | 0.004 | 19 | 1.669 | 0.666 | ns | 0.373 | small |
| p2 | VAN | SubCor | 0.030 | 0.027 | 0.033 | 19 | 22.687 | 0.000 | **** | 5.073 | large |
| p2 | VAN | TP | -0.003 | -0.008 | 0.002 | 19 | -1.395 | 0.895 | ns | -0.312 | small |
| p2 | Vis | DAN | -0.023 | -0.028 | -0.019 | 19 | -10.594 | 0.000 | **** | -2.369 | large |
| p2 | Vis | DMN | -0.015 | -0.020 | -0.010 | 19 | -6.211 | 0.000 | *** | -1.389 | large |
| p2 | Vis | FPN | -0.022 | -0.026 | -0.017 | 19 | -10.102 | 0.000 | **** | -2.259 | large |
| p2 | Vis | Limb | -0.018 | -0.024 | -0.012 | 19 | -6.601 | 0.000 | **** | -1.476 | large |
| p2 | Vis | SM | -0.010 | -0.013 | -0.007 | 19 | -6.353 | 0.000 | **** | -1.421 | large |
| p2 | Vis | SubCor | 0.010 | 0.006 | 0.014 | 19 | 4.825 | 0.002 | ** | 1.079 | large |
| p2 | Vis | TP | -0.023 | -0.030 | -0.017 | 19 | -7.363 | 0.000 | **** | -1.647 | large |
| p2 | Vis | VAN | -0.020 | -0.025 | -0.015 | 19 | -8.691 | 0.000 | **** | -1.943 | large |
6.5.5 Correlation Analysis
Modularity, Efficiency가 영상에 대한 이해도와 관련성이 있는지 확인한다.
6.5.5.1 Part 1 - Efficiency & Comprehension
r11_5 <- r11_2 %>% filter(check != 1) #corr == 1,
r11_6 <- r11_5 %>% filter(part == "p1", net == "All") %>% dplyr::select(sn, net,idx, part, ge, md1, scores, corr)
r11_6.L <- r11_6 %>% group_by(sn) %>%
dplyr::summarise(ge.m = mean(ge), m.m = mean(md1), scores.m = mean(scores)) %>%
ungroup()
cor.z <- cor.test(formula = ~ ge.m + scores.m, data = r11_6.L,
method = "pearson", alternative = "two.sided", exact=FALSE) # exact=FALSE
cor.z
##
## Pearson's product-moment correlation
##
## data: ge.m and scores.m
## t = -1.8265, df = 18, p-value = 0.08441
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.7131528 0.0570895
## sample estimates:
## cor
## -0.3954209
# cor.z <- cor.test(formula = ~ md1 + scores, data = r11_6,
# method = "pearson", alternative = "two.sided", exact=FALSE) # exact=FALSEr11.corr.ge <-ggplot(r11_6.L, aes(x=ge.m, y=scores.m)) +
geom_point(size = 4) +
geom_smooth(method=lm) +
labs(x = sprintf("Global Efficiency"),
y = sprintf("Comprehension Scores"))+
ggtitle("Part 1 - Global Efficiency") +
# coord_cartesian(xlim = c(-3,3), ylim = c(-3,4)) +
theme_bw(base_size = 15) +
theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
legend.position = c(0.65, 0.85),
legend.title = element_blank(),
aspect.ratio = 1,
legend.background = element_blank(),
plot.margin = margin(1, 0.5, 0.5, 0.7, "cm"),
legend.key = element_blank())
r11.corr.ge## `geom_smooth()` using formula 'y ~ x'
6.5.5.2 Part 2 - Efficiency & Comprehension
r11_5 <- r11_2 %>% filter(check != 1) #corr == 1,
r11_6 <- r11_5 %>% filter(part == "p2", net == "All") %>% dplyr::select(sn, net,idx, part, ge, md1, scores, corr)
r11_6.L <- r11_6 %>% group_by(sn) %>%
dplyr::summarise(ge.m = mean(ge), m.m = mean(md1), scores.m = mean(scores)) %>%
ungroup()
r11_6.L <- r11_6.L %>% filter(sn != 16)
cor.z <- cor.test(formula = ~ ge.m + scores.m, data = r11_6.L,
method = "pearson", alternative = "two.sided", exact=FALSE) # exact=FALSE
cor.z
##
## Pearson's product-moment correlation
##
## data: ge.m and scores.m
## t = -0.35512, df = 17, p-value = 0.7269
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.5197620 0.3833394
## sample estimates:
## cor
## -0.08581102
# cor.z <- cor.test(formula = ~ md1 + scores, data = r11_6,
# method = "pearson", alternative = "two.sided", exact=FALSE) # exact=FALSEr11.corr.ge <-ggplot(r11_6.L, aes(x=ge.m, y=scores.m)) +
geom_point(size = 4) +
geom_smooth(method=lm) +
labs(x = sprintf("Global Efficiency"),
y = sprintf("Comprehension Scores"))+
ggtitle("Part 2 - Global Efficiency") +
# coord_cartesian(xlim = c(-3,3), ylim = c(-3,4)) +
theme_bw(base_size = 15) +
theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
legend.position = c(0.65, 0.85),
legend.title = element_blank(),
aspect.ratio = 1,
legend.background = element_blank(),
plot.margin = margin(1, 0.5, 0.5, 0.7, "cm"),
legend.key = element_blank())
r11.corr.ge## `geom_smooth()` using formula 'y ~ x'
6.5.5.3 Part 1 - Modularity & Comprehension
r11_5 <- r11_2 %>% filter(check != 1) #corr == 1,
r11_6 <- r11_5 %>% filter(part == "p1", net == "All") %>% dplyr::select(sn, net,idx, part, ge, md1, scores, corr)
r11_6.L <- r11_6 %>% group_by(sn) %>%
dplyr::summarise(ge.m = mean(ge), m.m = mean(md1), scores.m = mean(scores)) %>%
ungroup()
cor.z <- cor.test(formula = ~ m.m + scores.m, data = r11_6.L,
method = "pearson", alternative = "two.sided", exact=FALSE) # exact=FALSE
cor.z
##
## Pearson's product-moment correlation
##
## data: m.m and scores.m
## t = -0.41793, df = 18, p-value = 0.6809
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.5180790 0.3601095
## sample estimates:
## cor
## -0.09803348
# cor.z <- cor.test(formula = ~ md1 + scores, data = r11_6,
# method = "pearson", alternative = "two.sided", exact=FALSE) # exact=FALSEr11.corr.m <-ggplot(r11_6.L, aes(x=m.m, y=scores.m)) +
geom_point(size = 4) +
geom_smooth(method=lm) +
labs(x = sprintf("Modularity"),
y = sprintf("Comprehension Scores"))+
ggtitle("Part 1 - Modularity") +
# coord_cartesian(xlim = c(-3,3), ylim = c(-3,4)) +
theme_bw(base_size = 15) +
theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
legend.position = c(0.65, 0.85),
legend.title = element_blank(),
aspect.ratio = 1,
legend.background = element_blank(),
plot.margin = margin(1, 0.5, 0.5, 0.7, "cm"),
legend.key = element_blank())
r11.corr.m## `geom_smooth()` using formula 'y ~ x'
6.5.5.4 Part 2 - Modularity & Comprehension
r11_5 <- r11_2 %>% filter(check != 1) #corr == 1,
r11_6 <- r11_5 %>% filter(part == "p2", net == "All") %>% dplyr::select(sn, net,idx, part, ge, md1, scores, corr)
r11_6.L <- r11_6 %>% group_by(sn) %>%
dplyr::summarise(ge.m = mean(ge), m.m = mean(md1), scores.m = mean(scores)) %>%
ungroup()
cor.z <- cor.test(formula = ~ m.m + scores.m, data = r11_6.L,
method = "pearson", alternative = "two.sided", exact=FALSE) # exact=FALSE
cor.z
##
## Pearson's product-moment correlation
##
## data: m.m and scores.m
## t = -1.7912, df = 18, p-value = 0.0901
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## -0.70936951 0.06471799
## sample estimates:
## cor
## -0.3889417r11.corr.m <-ggplot(r11_6.L, aes(x=m.m, y=scores.m)) +
geom_point(size = 4) +
geom_smooth(method=lm) +
labs(x = sprintf("Modularity"),
y = sprintf("Comprehension Scores"))+
ggtitle("Part 2 - Modularity") +
# coord_cartesian(xlim = c(-3,3), ylim = c(-3,4)) +
theme_bw(base_size = 15) +
theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
legend.position = c(0.65, 0.85),
legend.title = element_blank(),
aspect.ratio = 1,
legend.background = element_blank(),
plot.margin = margin(1, 0.5, 0.5, 0.7, "cm"),
legend.key = element_blank())
r11.corr.m## `geom_smooth()` using formula 'y ~ x'
7 Session Info
sessionInfo()
## R version 4.1.1 (2021-08-10)
## Platform: aarch64-apple-darwin20 (64-bit)
## Running under: macOS Monterey 12.1
##
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/4.1-arm64/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.1-arm64/Resources/lib/libRlapack.dylib
##
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
##
## attached base packages:
## [1] parallel stats graphics grDevices utils datasets methods
## [8] base
##
## other attached packages:
## [1] RColorBrewer_1.1-2 ppcor_1.1 MASS_7.3-54
## [4] sjPlot_2.8.9 caret_6.0-88 psycho_0.6.1
## [7] effects_4.2-0 latticeExtra_0.6-29 ggpubr_0.4.0
## [10] emmeans_1.6.3 lmerTest_3.1-3 afex_1.0-1
## [13] lme4_1.1-27.1 Matrix_1.3-4 psych_2.1.9
## [16] car_3.0-11 carData_3.0-4 knitr_1.37
## [19] forcats_0.5.1 stringr_1.4.0 dplyr_1.0.7
## [22] purrr_0.3.4 readr_2.0.1 tidyr_1.1.3
## [25] tibble_3.1.4 tidyverse_1.3.1 ggbeeswarm_0.6.0
## [28] ggplot2_3.3.5 effectsize_0.4.5 lsr_0.5.1
## [31] effsize_0.8.1 rstatix_0.7.0 Rmisc_1.5
## [34] plyr_1.8.6 lattice_0.20-44 pacman_0.5.1
## [37] klippy_0.0.0.9500 patchwork_1.1.0.9000 papaja_0.1.0.9997
## [40] devtools_2.4.2 usethis_2.0.1 distill_1.2
##
## loaded via a namespace (and not attached):
## [1] utf8_1.2.2 tidyselect_1.1.1 grid_4.1.1
## [4] pROC_1.18.0 munsell_0.5.0 codetools_0.2-18
## [7] future_1.22.1 withr_2.4.3 colorspace_2.0-2
## [10] highr_0.9 rstudioapi_0.13 stats4_4.1.1
## [13] ggsignif_0.6.3 listenv_0.8.0 labeling_0.4.2
## [16] mnormt_2.0.2 farver_2.1.0 datawizard_0.2.0.1
## [19] rprojroot_2.0.2 coda_0.19-4 parallelly_1.28.1
## [22] vctrs_0.3.8 generics_0.1.0 TH.data_1.1-0
## [25] ipred_0.9-12 xfun_0.29 R6_2.5.1
## [28] cachem_1.0.6 assertthat_0.2.1 scales_1.1.1
## [31] multcomp_1.4-18 nnet_7.3-16 beeswarm_0.4.0
## [34] gtable_0.3.0 downlit_0.2.1 globals_0.14.0
## [37] processx_3.5.2 sandwich_3.0-1 timeDate_3043.102
## [40] rlang_0.4.12 splines_4.1.1 ModelMetrics_1.2.2.2
## [43] broom_0.7.9.9000 yaml_2.2.1 reshape2_1.4.4
## [46] abind_1.4-5 modelr_0.1.8 backports_1.2.1
## [49] tools_4.1.1 lava_1.6.10 ellipsis_0.3.2
## [52] jquerylib_0.1.4 sessioninfo_1.1.1 Rcpp_1.0.7
## [55] ps_1.6.0 prettyunits_1.1.1 rpart_4.1-15
## [58] cowplot_1.1.1 zoo_1.8-9 haven_2.4.3
## [61] fs_1.5.0 survey_4.1-1 magrittr_2.0.1
## [64] data.table_1.14.0 openxlsx_4.2.4 reprex_2.0.1
## [67] tmvnsim_1.0-2 mvtnorm_1.1-2 sjmisc_2.8.7
## [70] pkgload_1.2.2 hms_1.1.0 evaluate_0.14
## [73] xtable_1.8-4 sjstats_0.18.1 rio_0.5.27
## [76] jpeg_0.1-9 readxl_1.3.1 ggeffects_1.1.1
## [79] testthat_3.0.4 compiler_4.1.1 crayon_1.4.2
## [82] minqa_1.2.4 htmltools_0.5.2 mgcv_1.8-36
## [85] tzdb_0.1.2 lubridate_1.7.10 DBI_1.1.1
## [88] sjlabelled_1.1.8 dbplyr_2.1.1 boot_1.3-28
## [91] cli_3.1.0 mitools_2.4 insight_0.14.4
## [94] gower_0.2.2 pkgconfig_2.0.3 numDeriv_2016.8-1.1
## [97] foreign_0.8-81 recipes_0.1.16 xml2_1.3.3
## [100] foreach_1.5.1 vipor_0.4.5 estimability_1.3
## [103] prodlim_2019.11.13 rvest_1.0.1 callr_3.7.0
## [106] digest_0.6.29 parameters_0.14.0 rmarkdown_2.11
## [109] cellranger_1.1.0 curl_4.3.2 nloptr_1.2.2.2
## [112] lifecycle_1.0.0 nlme_3.1-152 jsonlite_1.7.2
## [115] desc_1.3.0 fansi_0.5.0 pillar_1.6.2
## [118] fastmap_1.1.0 httr_1.4.2 pkgbuild_1.2.0
## [121] survival_3.2-11 glue_1.6.0 remotes_2.4.0
## [124] bayestestR_0.11.0 zip_2.2.0 png_0.1-7
## [127] iterators_1.0.13 performance_0.7.3 class_7.3-19
## [130] stringi_1.7.6 memoise_2.0.0 future.apply_1.8.1